vba VBA将另一个excel文件内容复制到当前工作簿

VBA to copy another excel file contents to current workbook

提问by harryg

This is what I want to achieve:

这就是我想要实现的目标：

I want to copy the contents of the entire first sheet in the most recently modified excel file in a specified directory. I then want to paste the values of this copy operation to the first sheet of the current workbook.

我想将最近修改的excel文件中的整个第一张工作表的内容复制到指定目录中。然后我想将此复制操作的值粘贴到当前工作簿的第一张纸上。

I am aware there are macros to get the last modified file in a directory but I am unsure of a quick and clean way to implement this.

我知道有宏可以获取目录中最后修改的文件，但我不确定实现这一点的快速而干净的方法。

回答by InContext

See below. This will use the current active workbook and look in C:\Your\Pathfor the Excel file with the latest modify date. It will then open the file and copy contents from the first sheet and paste them in your original workbook (on the first sheet):

见下文。这将使用当前活动工作簿并查找C:\Your\Path具有最新修改日期的 Excel 文件。然后它将打开文件并从第一张工作表复制内容并将它们粘贴到原始工作簿中（在第一张工作表上）：

Dim fso, fol, fil
Dim wkbSource As Workbook, wkbData As Workbook

Dim fileData As Date
Dim fileName As String, strExtension As String

Set wkbSource = ActiveWorkbook

Set fso = CreateObject("Scripting.FileSystemObject")
Set fol = fso.GetFolder("C:\Your\Path")

fileData = DateSerial(1900, 1, 1)

    For Each fil In fol.Files

        strExtension = fso.GetExtensionName(fil.Path)
        If Left$(strExtension, 3) = "xls" Then

            If (fil.DateLastModified > fileData) Then
                fileData = fil.DateLastModified
                fileName = fil.Path
            End If

        End If

    Next fil

Set wkbData = Workbooks.Open(fileName, , True)

wkbData.Sheets(1).Cells.Copy 
wkbSource.Sheets(1).Range("A1").PasteSpecial Paste:=xlValues

Application.CutCopyMode = False

wkbData.Close

Set fso = Nothing
Set fol = Nothing
Set flc = Nothing
Set wkbData = Nothing

回答by Chris

I had nothing better to do on my lunch - so here goes.

午餐时我无事可做——就这样吧。

To fire it use: getSheetFromA()

要触发它，请使用： getSheetFromA()

Put this in the current file:

把它放在当前文件中：

Dim most_recent_file(1, 2) As Variant
Sub getSheetFromA()

    ' STEP 1 - Delete first sheet in this workbook
    ' STEP 2 - Look through the folder and get the most recently modified file path
    ' STEP 3 - Copy the first sheet from that file to the start of this file


    ' STEP 1
    ' Delete the first sheet in the current file (named incase if deleting the wrong one..)
    delete_worksheet ("Sheet1")

    ' STEP 2
    ' Now look for the most recent file
    Dim folder As String
    folder = "C:\Documents and Settings\Chris\Desktop\foldername\"

    Call recurse_files(folder, "xls")

    ' STEP 3
    Dim most_recently_modified_sheet As String
    most_recently_modified_sheet = most_recent_file(1, 0)
    getSheet most_recently_modified_sheet, 1
End Sub

Sub getSheet(filename As String, sheetNr As Integer)
    ' Copy a sheet from an external sheet to this workbook and put it first in the workbook.
    Dim srcWorkbook As Workbook

    Set srcWorkbook = Application.Workbooks.Open(filename)
    srcWorkbook.Worksheets(sheetNr).Copy before:=ThisWorkbook.Sheets(1)

    srcWorkbook.Close
    Set srcWorkbook = Nothing
End Sub

Sub delete_worksheet(sheet_name)
    ' Delete a sheet (turn alerting off and on again to avoid prompts)
    Application.DisplayAlerts = False
    Sheets(sheet_name).Delete
    Application.DisplayAlerts = True
End Sub

Function recurse_files(working_directory, file_extension)
    With Application.FileSearch
        .LookIn = working_directory
        .SearchSubFolders = True
        .filename = "*." & file_extension
        .MatchTextExactly = True
        .FileType = msoFileTypeAllFiles

        If .Execute() > 0 Then
            number_of_files = .FoundFiles.Count
            For i = 1 To .FoundFiles.Count
                vFile = .FoundFiles(i)

                Dim temp_filename As String
                temp_filename = vFile

                ' the next bit works by seeing if the current file is newer than the one in the array, if it is, then replace the current file in the array.
                If (most_recent_file(1, 1) <> "") Then
                    If (FileLastModified(temp_filename) > most_recent_file(1, 1)) Then
                        most_recent_file(1, 0) = temp_filename
                        most_recent_file(1, 1) = FileLastModified(temp_filename)
                    End If
                Else
                    most_recent_file(1, 0) = temp_filename
                    most_recent_file(1, 1) = FileLastModified(temp_filename)
                End If
            Next i
        Else
            MsgBox "There were no files found."
        End If
    End With
End Function

Function FileLastModified(strFullFileName As String)
    ' Taken from: http://www.ozgrid.com/forum/showthread.php?t=27740
    Dim fs As Object, f As Object, s As String

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(strFullFileName)


    s = f.DateLastModified
    FileLastModified = s

    Set fs = Nothing: Set f = Nothing

End Function