大师请进：用VBA如何从工作薄文件导入到工作表（发贴几天了，无人问津）

ugyun

各位大师：
     您好！请帮忙修改代码，用VBA实现：   
   怎样从指定的工作薄文件中将有数据的区域复制过来，以此为例，要从“备份2010.8.24”中“表二”的E4:P复制到本工作薄“凭证登记”的“表二”中的E4:P里来,假设两个文件不在同一目录下，浏览文件夹选择文件再复制导入。
   “备份2010.8.24”工作表保护密码为：81452,工作薄保护密码为：12345。

[ 本帖最后由 ugyun 于 2010-8-26 18:43 编辑 ]

ugyun

各位老师，各位大师：
  对上面的“凭证登记”，我只起了个头：  
Private Sub CommandButton1_Click() '导入
    Dim wkbk As Workbook '定义一个工作薄
    Dim MyFileName As String '定义要读取的文件路径
     MyFileName = Application.GetOpenFilename(filefilter:="Microsoft Office Excel 工作薄 (*.xls),*.xls,Excel97～2003 (*.xls), *.xls,Excel2007 (*.xlsx), *.xlsx,所有文件(*.*),*.*", Title:="请选择要导入的文件")
       If MyFileName = False Then Exit Sub
       这里都不知道怎么写下去了……
End Sub



现在我找到一个范例：
Public Sub 按钮1_单击()
    Dim DbPath As String, sName As String
    Dim Filename As Variant                      '预先无法知道此数组大小，因预先无法知道要打开的文件数
    Dim intTblCnt As Integer
    Dim strTbl As String, a() As String
    Dim intColCnt As Integer
    Dim t As Integer, c As Integer, f As Integer, Count As Integer
    Dim Sql As String

    intColCnt = Cells(1, 256).End(xlToLeft).Column
    ReDim a(intColCnt + 2)
      
    Filename = Application.GetOpenFilename("Microsoft Office Excel Files (*.xls), *.xls", , "请选取文件", , MultiSelect:=True)
    If Not IsArray(Filename) Then Exit Sub
   
    For Each fn In Filename                     '在整个选择的范围内循环
        'Application.ScreenUpdating = False
        sName = Application.WorksheetFunction.Substitute(fn, ThisWorkbook.Path & "\", "")
        Workbooks.Open fn              '打开文件以检查是否存在需要的字段名
        Set cn = New ADODB.Connection
        With cn
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .ConnectionString = "Data Source=" & fn & ";Extended Properties=Excel 8.0;"
            .CursorLocation = adUseClient
            .Open
        End With
        intTblCnt = ActiveWorkbook.Sheets.Count
        For t = 1 To intTblCnt
            Count = 0
            ActiveWorkbook.Sheets(t).Select
            Sql = ""
            intFldsCnt = ActiveWorkbook.Sheets(t).Cells(1, 256).End(xlToLeft).Column
            strTbl = ActiveWorkbook.Sheets(t).Name
            For c = 1 To intColCnt
                sign = 0
                a(c) = ThisWorkbook.Sheets(1).Cells(1, c).Value
                a(c + 1) = ThisWorkbook.Sheets(1).Cells(1, c + 1).Value
                For f = 1 To intFldsCnt
                    With ActiveWorkbook.Sheets(t)
                        If Cells(1, f) = a(c) Then
                            sign = 1
                            Sql = Sql & a(c) & ","
                        End If
                    End With
                Next
                If sign = 0 Then
                    Count = Count + 1
                    Sql = Sql & a(c + 1) & ","
                End If
            Next
            Sql = Left(Sql, Len(Sql) - 1)
            If Len(Sql) = 0 Or Count = intColCnt Then
                GoTo Label1
            End If
            Sql = "Select " & Sql & " FROM [" & strTbl & "$] "
            ThisWorkbook.Sheets(1).Cells(65535, 1).End(xlUp).Offset(1, 0).CopyFromRecordset cn.Execute(Sql)
Label1:
        Next                                '对文件中的表遍历
        cn.Close
        Workbooks(sName).Close False
    Next                                    '文件遍历
    Set cn = Nothing
    Application.ScreenUpdating = True
End Sub





以上是附件“通用多文件条件汇总－ADO应用”中的代码，但我看不懂，烦请老师根据这个范例对上面的“凭证登记”进行修改。谢谢了。

[ 本帖最后由 ugyun 于 2010-8-25 19:12 编辑 ]