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

时间:2016-07-20 16:35:05

标签: excel vba excel-vba macros

我有一张没有大约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

2 个答案:

答案 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