Excelmacros导入CSV文件覆盖现有的工作簿选项卡
以下代码源自rondebruin.nl的非常有用的信息。 它将选定的csv文件导入到xls工作簿中的单独的选项卡中。 有两件事我想改变。
我无法在这个网站上find答案或者在一般的search中，我非常感谢这里的专家给予的帮助，希望这是其他人的兴趣。
1）代码当前覆盖或删除运行的工作簿中现有的第一张工作表 – 我希望在任何情况下都可以在本工作簿的前面保留一张表
2）在后续运行，新标签添加后退出标签 – 我想覆盖现有的标签重新导入相同的CSV文件。
…感谢任何帮助…
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 你正在用这行代码删除你的第一张工作表：
basebook.Worksheets(1).Delete
正如它在评论中所说的那样。 如果你不想这样做，那么你不应该在那里。 我认为一直在消失的工作表就是这样一个。
只要您希望用新数据覆盖选项卡而不是创build新选项卡，则可以先创build对选项卡名称的search，如果该选项卡存在，则将CSV复制并粘贴到该表单上。 如果不存在，请使用该名称创build一个新选项卡，并将数据粘贴到新选项卡中。