我有一张没有大约30页左右的工作簿,我有一个宏来保存每个工作表中的选择作为文本文件。我的代码在下面,目前只有C:\ data作为路径。我想做的是在'for each'循环之前有一点提示用户选择保存路径(团队驱动器),然后循环执行并将所有文件导出到该路径。任何人都可以帮助我吗?
谢谢,Rich
Sub Exporttotext()
Dim c As Range, r As Range
Dim output As String
Dim lngcount As Long
Dim WS As Worksheet
Dim Name As String
For Each sh In ThisWorkbook.Worksheets
output = ""
For Each r In sh.Range("O2:O500").Rows
For Each c In r.Cells
output = output & c.Value
Next c
output = output & vbNewLine
Next r
Name = sh.Name
Open "C:\data\" & Name & ".txt" For Output As #1
Print #1, output
Close
Next
End Sub
答案 0 :(得分:0)
请参阅示例代码以启动路径选择UI。
Sub test()
Dim strFolder As String
strFolder = GetFolder("C:\temp\")
'/ Opens in that folder
'strFolder = GetFolder("C:\temp\")
If strFolder <> "" Then
MsgBox strFolder
End If
End Sub
Function GetFolder(Optional strPath As String = "") As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select Output Report Location"
.AllowMultiSelect = False
If strPath <> "" Then
.InitialFileName = strPath
End If
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
答案 1 :(得分:0)
您可以使用输入框来完成此任务:
Sub Exporttotext()
Dim c As Range, r As Range
Dim output As String
Dim lngcount As Long
Dim WS As Worksheet
Dim Name As String
Dim sSharedPath As String
sSharedPath = InputBox("What is the path", "Destination", "\\MyPath\")
For Each sh In ThisWorkbook.Worksheets
output = ""
For Each r In sh.Range("O2:O500").Rows
For Each c In r.Cells
output = output & c.Value
Next c
output = output & vbNewLine
Next r
Name = sh.Name
Open sSharedPath & Name & ".txt" For Output As #1
Print #1, output
Close
Next
End Sub