Question

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

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

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

Answer 1

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

    basebook.Worksheets(1).Delete

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

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

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

1 个答案: