要導入CSV文件的Excel宏覆蓋現有的工作簿選項卡

Question

以下代碼源於rondebruin.nl上非常有用的信息。它將選定的csv文件導入xls工作簿中的單獨選項卡。有兩件事我想改變。

我無法找到這個問題的答案在本網站或在一般的搜索，我將非常感激從這裏一些專家的幫助，希望這是關心他人......

1）當前的代碼覆蓋或刪除工作簿中現有的第一張工作表 - 我希望在所有情況下在此工作簿的前面保留一張工作表

2）對於後續運行，在退出後添加新選項卡選項卡 - 我想在重新導入相同的csv文件時覆蓋現有的選項卡。因爲它在評論中說

basebook.Worksheets(1).Delete 

：

...感謝所有幫助...

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 

Answer 1

您要刪除這一行代碼第一個工作表。如果你不想這樣做，那麼你不應該在那裏有那條線。我認爲一直保持減免的工作表就是那個。

至於你的願望，用新數據覆蓋，而不是創建新的選項卡的標籤，你可以先創建的標籤名稱的搜索，如果該選項卡存在，然後複製並粘貼到CSV該表。如果它不存在，請創建一個具有該名稱的新選項卡並將數據粘貼到新選項卡中。