vba 用于导入 CSV 文件的 Excel 宏覆盖现有工作簿选项卡

Excel macro to import CSV files overwrite existing workbook tabs

提问by rdh9

The following code originated from the very helpful info at rondebruin.nl. It imports selected csv files into separate tabs in a xls workbook. There are two things I would like to change.

以下代码源自 rondebruin.nl 上非常有用的信息。它将选定的 csv 文件导入到 xls 工作簿中的单独选项卡中。有两件事我想改变。

I cannot find the answer to this on this site or in a general search and I would much appreciate some help from the experts here, hope this is of interest to others...

我无法在本网站或一般搜索中找到此问题的答案，非常感谢这里专家的帮助，希望其他人对此感兴趣...

1) the code currently overwrites or deletes the existing first sheet in the workbook from which it is run -- I would like to keep a single sheet at the front of this workbook under all circumstances

1）代码当前覆盖或删除了运行它的工作簿中现有的第一张工作表 - 我想在任何情况下都在此工作簿的前面保留一张工作表

2) on subsequent runs, new tabs are added after exiting tabs -- I would like to overwrite existing tabs when re-importing the same csv file.

2) 在后续运行中，退出选项卡后会添加新选项卡——我想在重新导入相同的 csv 文件时覆盖现有选项卡。

...appreciate any help...

...感谢任何帮助...

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetCurrentDirectoryA Lib _
        "kernel32" (ByVal lpPathName As String) As Long
#Else
    Private Declare Function SetCurrentDirectoryA Lib _
        "kernel32" (ByVal lpPathName As String) As Long
#End If

Function ChDirNet(szPath As String) As Boolean
'based on Rob Bovey's code
    Dim lReturn As Long
    lReturn = SetCurrentDirectoryA(szPath)
    ChDirNet = CBool(lReturn <> 0)
End Function

Sub Get_CSV_Files()
'For Excel 2000 and higher
    Dim Fnum As Long
    Dim mybook As Workbook
    Dim basebook As Workbook
    Dim CSVFileNames As Variant
    Dim SaveDriveDir As String
    Dim ExistFolder As Boolean

    'Save the current dir
    SaveDriveDir = CurDir

    'You can change the start folder if you want for
    'GetOpenFilename,you can use a network or local folder.
    'For example ChDirNet("C:\Users\Ron\test")
    'It now use Excel's Default File Path

    ExistFolder = ChDirNet("C:\test")
    If ExistFolder = False Then
        MsgBox "Error changing folder"
        Exit Sub
    End If

    CSVFileNames = Application.GetOpenFilename _
        (filefilter:="CSV Files (*.csv), *.csv", MultiSelect:=True)

    If IsArray(CSVFileNames) Then

        On Error GoTo CleanUp

        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        'Add workbook with one sheet
        'Set basebook = Workbooks.Add(xlWBATWorksheet)
        Set basebook = ThisWorkbook

        'Loop through the array with csv files
        For Fnum = LBound(CSVFileNames) To UBound(CSVFileNames)

            Set mybook = Workbooks.Open(CSVFileNames(Fnum))

            'Copy the sheet of the csv file after the last sheet in
            'basebook (this is the new workbook)
            mybook.Worksheets(1).Copy After:= _
                                     basebook.Sheets(basebook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = Right(CSVFileNames(Fnum), Len(CSVFileNames(Fnum)) - _
                                            InStrRev(CSVFileNames(Fnum), "\", , 1))
            On Error GoTo 0

            mybook.Close savechanges:=False

        Next Fnum

        'Delete the first sheet of basebook
        On Error Resume Next
        Application.DisplayAlerts = False
        basebook.Worksheets(1).Delete
        Application.DisplayAlerts = True
        On Error GoTo 0

CleanUp:

        ChDirNet SaveDriveDir

        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If
End Sub

回答by Rrgg

You are deleting your first worksheet with this line of code:

您正在使用以下代码行删除您的第一个工作表：

    basebook.Worksheets(1).Delete

as it says in the comments. If you don't want to do that, then you shouldn't have that line in there. I presume the worksheet that keeps disapearing is that one.

正如评论中所说。如果你不想这样做，那么你就不应该在那里放那条线。我认为不断消失的工作表就是那个。

As far as your desire to overwrite tabs with new data instead of creating new tabs, you might create a search for the tab name first and if that tab exists, then copy and paste the CSV onto that sheet. If it doesn't exist create a new tab with that name and paste the data into a new tab.

如果您希望用新数据覆盖选项卡而不是创建新选项卡，您可以先创建选项卡名称的搜索，如果该选项卡存在，则将 CSV 复制并粘贴到该工作表上。如果它不存在，请使用该名称创建一个新选项卡并将数据粘贴到新选项卡中。