macros使用可视文件select器将每个工作表保存为单独的xls文件

我一直在使用下面链接的解决scheme，保存多个工作表以分离CSV，并且希望将类似的解决scheme保存到XLS中。 我想分离每个工作表到他们自己的XLS文件，但仍然有一个文件select器来select他们保存的path。

我试图修改这个代码无济于事 – 任何想法？

将每张工作表保存在工作簿中以分隔CSV文件

Answer 1

该解决scheme是您提供的链接中前两名的混合。

' ---------------------- Directory Choosing Helper Functions ----------------------- ' Excel and VBA do not provide any convenient directory chooser or file chooser ' dialogs, but these functions will provide a reference to a system DLL ' with the necessary capabilities Private Type BROWSEINFO ' used by the function GetFolderName hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Function GetFolderName(Msg As String) As String ' returns the name of the folder selected by the user Dim bInfo As BROWSEINFO, path As String, r As Long Dim X As Long, pos As Integer bInfo.pidlRoot = 0& ' Root folder = Desktop If IsMissing(Msg) Then bInfo.lpszTitle = "Select a folder." ' the dialog title Else bInfo.lpszTitle = Msg ' the dialog title End If bInfo.ulFlags = &H1 ' Type of directory to return X = SHBrowseForFolder(bInfo) ' display the dialog ' Parse the result path = Space$(512) r = SHGetPathFromIDList(ByVal X, ByVal path) If r Then pos = InStr(path, Chr$(0)) GetFolderName = Left(path, pos - 1) Else GetFolderName = "" End If End Function '---------------------- END Directory Chooser Helper Functions ---------------------- Public Sub DoTheExport() Dim FName As Variant Dim Sep As String Dim wsSheet As Worksheet Dim nFileNum As Integer Dim xlsPath As String xlsPath = GetFolderName("Choose the folder to export files to:") If xlsPath = "" Then MsgBox ("You didn't choose an export directory. Nothing will be exported.") Exit Sub End If 'MsgBox xlsPath For Each wsSheet In Worksheets ' make a copy to create a new book with this sheet ' otherwise you will always only get the first sheet wsSheet.Copy ' this copy will now become active ActiveWorkbook.SaveAs Filename:=xlsPath + "\" + wsSheet.Name & ".xls", CreateBackup:=False ActiveWorkbook.Close Next wsSheet End Sub