从目录中获取文件并将其与vba中的名称隔离

时间:2013-10-01 08:58:06

标签: excel vba excel-vba

我需要使用VB宏进行自动化,我必须从特定文件夹中获取一组xls文件并将它们转换为csv,然后根据文件名将其隔离,如所有文件名将有利于将其放入一个名为benifit的新文件夹,所有基金将被放入一个名为funds的文件夹中(我们必须在某个路径中创建一个文件夹)。

我有代码通过硬编码路径将xls转换为csv,但我不知道如何将其与名称隔离。

任何想法或代码都将不胜感激

提前致谢

<>

以下代码获取文件所在的输入路径,并将它们一次性转换为csv到输出路径

现在我想将此代码增强到

 Sub ConvertXLStoCSVNoRules(mySourcePath, myKeywordPath)
Set MyObject = New Scripting.FileSystemObject
Set strInputFolder = MyObject.GetFolder(mySourcePath)
Set strOutputFolder = MyObject.GetFolder(myKeywordPath)
strInputFolder = strInputFolder & "\"
strOutputFolder = strOutputFolder & "\"
strXLSFile = Dir(strInputFolder & "*.xls*")
counter = 0
row = 13
Worksheets("Main").Cells(row, 1).Value = "Files processed at " & Now
row = row + 1
On Error Resume Next
Do While strXLSFile <> ""
    counter = counter + 1
    row = row + 1

    'strCSVFile = Left(strXLSFile, InStrRev(strXLSFile, ".")) & "csv"
    strCSVFile = Left(strXLSFile, 4) & " SL" & ".csv"

    'Add into the first sheet for recording purpose
    Worksheets("Main").Cells(row, 1).Value = strXLSFile

    Workbooks.Open strInputFolder & strXLSFile
    ActiveWorkbook.SaveAs strOutputFolder & strCSVFile, xlCSV
    ActiveWorkbook.Close False
    strXLSFile = Dir

Loop
    'MsgBox ("Files completed " & counter)
    row = row + 1
    Worksheets("Main").Cells(row, 1).Value = "Files completed " & counter & " at " & Now
End Sub
  • 根据新文件夹
  • 中的文件名对文件进行分类
  • 例如,文件夹中有100个文件,上面的代码会将其转换为csv并将其放在给定的路径中

但是我想要增强它的代码应该从文件名中分离csv或xls文件,就像文件名中的所有文件都应该来到一个名为benifits的新文件夹

所有带资金的文件都应该进入一个名为funds的新文件夹,它可以在csv转换之前甚至之后发生,

请建议我最好的方式

1 个答案:

答案 0 :(得分:0)

您可以根据输入的文件名更改输出文件名,代码类似于以下内容:

Dim Index As Integer
Dim outputFolder As String
Dim specialFolders(1 To 2) As String

specialFolders(1) = "funds"
specialFolders(2) = "benifit"

outputFolder = strOutputFolder
For Index = LBound(specialFolders) To UBound(specialFolders)
    If InStr(1, strCSVFile, specialFolders(Index), vbTextCompare) > 0 Then
        outputFolder = outputFolder & specialFolders(Index) & "\"
        Exit For
    End If
Next

ActiveWorkbook.SaveAs outputFolder & strCSVFile, xlCSV