根据参考列表将CSV文件导入Excel

问题描述 投票:0回答:1

我有一个 Excel 文件,我构建了该文件来导入给定日期的所有 csv 文件(由用户使用消息框输入。这一切都正常且符合预期。

我想要做的更改是仅导入以特定参考列表中给出的名称开头的 csv 文件。 例如...

文件名:

  • 文件1-基本
  • 文件1-扩展
  • 文件2-基本
  • 文件2-扩展
  • File3-基本
  • 文件 3 扩展
  • 文件4-基本
  • 文件4-扩展

主电子表格中存储的参考列表如下:

  • 文件1
  • 文件3

在这种情况下,我希望代码导入以 File1 和 File3 开头的所有文件并忽略其余文件。

到目前为止,我的 csv 导入有以下内容,但正如我所说,它会导入该文件夹中的所有内容。

    Public Sub CombineFiles()

    i = 0
    
    myValue = InputBox("How many days do you wish to import data from? (0 = Today)", "Date Rollback", 0)
'inform user
    If Not IsNumeric(myValue) Then
        MsgBox "Numeric Values Only", 48, "Numeric Values Only"
        Exit Sub
    Else
    
    Sheets("Dashboard").Range("K3").Value = "LOADING"
    
    Sheets("ImportedData").Cells.Clear
    Sheets("DuplicateRecords").Cells.Clear
    
    ThisWorkbook.Activate
    ThisWorkbook.Worksheets("ImportedData").Select

    Set S = Worksheets("ImportedData")
    
    boolGetHeaders = True

    strPath = "folderpath" & Format(DateAdd("d", -myValue, CDate(Date)), "yyyy-MM-dd") & "\"
    If Dir$(strPath) = "" Then
    MsgBox "Folder not found - " & strPath, 48, "Folder Not Found"
    Exit Sub
    End If
    FindFilesFromFolders strPath
    
End If

With ActiveWorkbook.Worksheets("NameList")

LastRowColumnA = .Range("A" & Rows.Count).End(xlUp).Row

For Each myCell In .Range("A2:A" & LastRowColumnA)

    strFile = strPath & myCell.Value & "-*.csv"

    If Len(Dir(strFile)) > 0 Then

        Sheets.Add Type:=strFile, After:=Worksheets(Worksheets.Count)
        
        FindFilesFromFolders strPath

    Else: myCell.Offset(0, 7) = "File Not Found"
    End If

Next

End With

End Sub
vba csv import
1个回答
0
投票

只需在导入文件之前测试该条件,例如

If Left(myCell.Value, 4) = "File1" Or Left(myCell.Value, 4) = "File3" Then

    strFile = strPath & myCell.Value & "-*.csv"

    If Len(Dir(strFile)) > 0 Then

        Sheets.Add Type:=strFile, After:=Worksheets(Worksheets.Count)
        
        FindFilesFromFolders strPath

    Else
        myCell.Offset(0, 7) = "File Not Found"
    End If
End If
© www.soinside.com 2019 - 2024. All rights reserved.