如何将目录选择器添加到宏

时间:2014-01-29 20:48:49

标签: excel excel-vba directory vba

而不是对目录进行硬编码我想打开目录选择器功能,以便用户可以选择Source文件夹和Target文件夹以获取以下内容:

Sub XlsToTxt()
    Dim aFile As String
    Const SourceFolder = "C:\Users\Documents\PCS\" ' note the backslash at the end of the string
    Const targetFolder = "C:\Users\Desktop\PCS Text\" ' note the backslash at the end of the string
    Application.DisplayAlerts = False
    aFile = Dir(SourceFolder & "*.xls")
    Do While aFile <> ""
        Workbooks.Open SourceFolder & aFile
        ActiveWorkbook.SaveAs targetFolder & Left(aFile, Len(aFile) - 4) _
        & ".csv", FileFormat:=xlCSV _
        , CreateBackup:=False
        ActiveWorkbook.Close
        aFile = Dir
    Loop
    Application.DisplayAlerts = True
End Sub

2 个答案:

答案 0 :(得分:0)

这:fnameandpath = Application.GetOpenFilename(Title:="Select File")

将打开文件选择器对话框,供用户选择源文件和目标文件。它们可以正常浏览,在选择文件时,返回完整路径和文件名进行处理

修改

添加过滤器 - fnameandpath = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls",Title:="Select File")

答案 1 :(得分:0)

试试这个:

Sub XlsToTxt()
    Dim aFile As String
    Dim SourceFolder As String
    Dim targetFolder As String

    With Application.FileDialog(msoFileDialogFolderPicker)
      .AllowMultiSelect = False
      .Title = "Select Source folder"
      .Show
      On Error Resume Next
      SourceFolder = .SelectedItems(1) & "\"
      On Error GoTo 0
    End With
    With Application.FileDialog(msoFileDialogFolderPicker)
      .AllowMultiSelect = False
      .Title = "Select Target folder"
      .Show
      On Error Resume Next
      targetFolder = .SelectedItems(1) & "\"
      On Error GoTo 0
    End With

    If SourceFolder = "" Or targetFolder = "" Then Exit Sub

    Application.DisplayAlerts = False
    aFile = Dir(SourceFolder & "*.xls")
    Do While aFile <> ""
        Workbooks.Open SourceFolder & aFile
        ActiveWorkbook.SaveAs targetFolder & Left(aFile, Len(aFile) - 4) _
        & ".csv", FileFormat:=xlCSV _
        , CreateBackup:=False
        ActiveWorkbook.Close
        aFile = Dir
    Loop
    Application.DisplayAlerts = True
End Sub