而不是对目录进行硬编码我想打开目录选择器功能,以便用户可以选择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
答案 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