2017-08-16 29 views
1

我已經編寫了用於將多個工作簿中的數據合併到一個工作簿的代碼,並且代碼僅打開xls格式文件,但某些文件具有csv格式文件夾。如何打開文件夾中的csv和xls文件?任何建議,它會讚賞如何打開文件夾中的所有文件(xls和csv格式文件) - VBA

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 

回答

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 
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 
+0

16秒晚^^。但是你的回答更好,因爲你擁有所有結果。所以1+ – Moosli

相關問題