0

以下代码源自 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
4

1 回答 1

3

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

    basebook.Worksheets(1).Delete

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

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

于 2013-10-21T20:59:34.990 回答