国产一级a片免费看高清,亚洲熟女中文字幕在线视频,黄三级高清在线播放,免费黄色视频在线看

Sub pldrwb1203()
'匯總.xls
    Dim myFs As FileSearch, Sht1 As Worksheet, Sht As Worksheet
    Dim myPath As String, Filename$
    Dim i As Long, n As Long,aa,nm$,na%
    Dim conn As Object, yy As Object, sql As String
    Set Sht1 = ActiveSheet
    Sht1.[a2:c1000] = ""
    Set conn = CreateObject("Adodb.Connection")
    Set myFs = Application.FileSearch
    myPath = ThisWorkbook.Path
    With myFs
        .NewSearch
        .LookIn = myPath
        .FileType = msoFileTypeNoteItem
        .Filename = "*.xls"
        If .Execute(SortBy:=msoSortByFileName) > 0 Then
            n = .FoundFiles.Count
            ReDim myfile(1 To n) As String
            For i = 1 To n
                myfile(i) = .FoundFiles(i)
                Filename = myfile(i)
                aa = InStrRev(Filename, "\")
                nm = Right(Filename, Len(Filename) - aa)      '帶后綴的Excel文件名
        If nm = ThisWorkbook.Name Then GoTo 100
         
        conn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0';data source=" & Filename   
                sql = "select A.單位名稱,B.單位人員數(shù)量,C.單位領(lǐng)導(dǎo)數(shù)量 from [表一$] as A,[表二$] as B,[表三$] as C"
                na = Sht1.[a65536].End(xlUp).Row + 1
                Sht1.Cells(na, 1).CopyFromRecordset conn.Execute(sql)
                conn.Close
100:            Next i
                Set conn = Nothing
        Else
            MsgBox "該文件夾里沒有任何文件"
        End If
    End With
    [a1].Select
    Set myFs = Nothing
End Sub