Excel VBA:获取子文件夹'将名称作为字符串数组

时间:2015-06-28 00:21:43

标签: excel vba excel-vba

我的VBA程序代码访问每个子文件夹中的文件。所以我存储了那些子文件夹'数组中的名称并使用for循环访问。我想让我的程序更通用。我们如何才能获得子文件夹' name作为变量的字符串数组?如果您知道任何功能,请帮助我。提前谢谢。

我的代码

Sub CSVtoXLSX_Click()
 Dim CSVfolder As String, XlsFolder As String, fname As String
 Dim wBook As Workbook
 Dim vArr, vFile
 vArr = Array("subfolder1", "subfolder2", "subfolder3", "subfolder4", "subfolder5")
 CSVfolder = "C:\Work\"
 XlsFolder = "C:\Work\"
 For Each vFile In vArr
 fname = Dir(CSVfolder & vFile & "\" & "*.csv")
 Do While fname <> ""
    Application.ScreenUpdating = False
    Set wBook = Workbooks.Open(CSVfolder & vFile & "\" & fname, Format:=6, Delimiter:=",")
    wBook.SaveAs XlsFolder & vFile & "\" & Replace(fname, ".csv", ""), xlOpenXMLWorkbook
    Application.CutCopyMode = False
    wBook.Close False
 fname = Dir()
 Loop
 Kill CSVfolder & vFile & "\" & "*.csv"
 Next
End Sub

1 个答案:

答案 0 :(得分:2)

试试这个:

Sub CSVtoXLSX_Click()
 Dim CSVfolder As String, XlsFolder As String, fname As String
 Dim wBook As Workbook
 Dim colSF As Collection, vFile
 Dim bHadFiles As Boolean

 CSVfolder = "C:\Work\"
 XlsFolder = "C:\Work\"

 Set colSF = GetSubFolders(CSVfolder)
 For Each vFile In colSF
    fname = Dir(CSVfolder & vFile & "\" & "*.csv")
    bHadFiles = False
    Do While fname <> ""
        bHadFiles = True '<< at least one file to delete using Kill...
        Application.ScreenUpdating = False
        Set wBook = Workbooks.Open(CSVfolder & vFile & "\" & fname, _
                                   Format:=6, Delimiter:=",")

        wBook.SaveAs XlsFolder & vFile & "\" & Replace(fname, ".csv", ""), _
                      xlOpenXMLWorkbook

        Application.CutCopyMode = False
        wBook.Close False
        fname = Dir()
    Loop
    If bHadFiles Then Kill CSVfolder & vFile & "\" & "*.csv" '<< will error if nothing to delete
 Next
End Sub


'get all subfolders under the provided path
'  return as a Collection
Function GetSubFolders(sPath As String) As Collection

    Dim col As New Collection, f

    f = Dir(sPath, vbDirectory + vbNormal)
    Do While f <> ""
        If GetAttr(sPath & f) And vbDirectory Then
            If f <> "." And f <> ".." Then col.Add f
        End If
        f = Dir()
    Loop
    Set GetSubFolders = col

End Function