如何打开文件夹中的所有文件(xls和csv格式文件) - VBA

时间:2017-08-16 10:34:56

标签: excel vba excel-vba

我编写的代码用于将来自多个工作簿的数据合并到一个工作簿中,而代码只打开xls格式文件,但某些文件在文件夹中有csv格式。如何在文件夹中打开csv和xls文件?任何建议,它会赞赏

Option Explicit

Sub ImportGroups()
Dim fPATH As String, fNAME As String
Dim LR As Long, LastRow As Long
Dim wb2, wb1 As Workbook, ofs As Worksheet

Set ofs = ThisWorkbook.Sheets("Sheet3")


fPATH = "C:\Users\ashokkumar.d\Desktop\MFI\"       

fNAME = Dir(fPATH & "*.xls")        'get the first filename in fpath

Do While Len(fNAME) > 0
    Set wb1 = Workbooks.Open(fPATH & fNAME)   'open the file

    LastRow = ofs.Range("B" & Rows.Count).End(xlUp).Row
    ofs.Range("B" & LastRow).Offset(1, -1).Value = fNAME

    Sheets("Input").Range("C8:J12").Copy
    ofs.Range("B" & LastRow).Offset(1, 0).PasteSpecial xlPasteValues



    wb1.Close False   'close data workbook
        fNAME = Dir         'get the next filename
Loop


 LR = ofs.Range("C" & Rows.Count).End(xlUp).Row
 ofs.Range("E2:I" & LR).Select
 Selection.NumberFormat = "0.00%"
 Application.ScreenUpdating = True
 ofs.Range("A1:Z" & LR).Select
 With Selection
    WrapText = True
    End With

End Sub

2 个答案:

答案 0 :(得分:2)

就像这样:

fNAME = Dir(fPATH & "*")        'get the first filename in fpath
Do While Len(fNAME) > 0
    dim ext as string, p as integer
    p = inStrRev(fName, ".")
    ext = ucase(mid(fName, p+1))
    if ext = "CSV" or ext = "XLS" or ext = "XLSX" or ext = "XLST" then
        Set wb1 = Workbooks.Open(fPATH & fNAME)   'open the file
        ...
    end if

答案 1 :(得分:1)

您可以获取文件夹中的所有文件,然后检查该文件是CSV还是xlsx文件。然后像你一样打开它。

    Option Explicit

    Sub ImportGroups()
    Dim fPATH As String, fNAME As String
    Dim LR As Long, LastRow As Long
    Dim wb2, wb1 As Workbook, ofs As Worksheet

    Set ofs = ThisWorkbook.Sheets("Sheet3")


    fPATH = "C:\Users\ashokkumar.d\Desktop\MFI\"       

    fNAME = Dir(fPATH & "*.*")        'get the first filename in fpath

    Do While Len(fNAME) > 0
If Right(fNAME, 4) = "xlsx" Or Right(fNAME, 4) = ".csv" Then
        Set wb1 = Workbooks.Open(fPATH & fNAME)   'open the file

        LastRow = ofs.Range("B" & Rows.Count).End(xlUp).Row
        ofs.Range("B" & LastRow).Offset(1, -1).Value = fNAME

        Sheets("Input").Range("C8:J12").Copy
        ofs.Range("B" & LastRow).Offset(1, 0).PasteSpecial xlPasteValues



        wb1.Close False   'close data workbook
            fNAME = Dir         'get the next filename
end if
    Loop


     LR = ofs.Range("C" & Rows.Count).End(xlUp).Row
     ofs.Range("E2:I" & LR).Select
     Selection.NumberFormat = "0.00%"
     Application.ScreenUpdating = True
     ofs.Range("A1:Z" & LR).Select
     With Selection
        WrapText = True
        End With

    End Sub