VBA插入宏以选择导出文件的保存路径

Question

我有一个没有大约 30 张左右工作表的工作簿，并且我有一个宏可以将每个工作表中的选择保存为文本文件。我的代码在下面，目前只有 C:\data 作为路径。我想要做的是在提示用户选择保存路径（团队驱动器）的“for each”循环之前有一点，然后循环执行并将所有文件导出到该路径。谁能帮帮我？

谢谢，里奇

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

Answer 1

查看示例代码以启动路径选择 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

Answer 2

您可以使用输入框来完成此操作：

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