VBA in Makro einfügen, um den Speicherpfad zum Exportieren von Dateien zu wählen

Question

Ich habe eine Arbeitsmappe ohne etwa 30 Blätter und ich habe ein Makro, um eine Auswahl aus jedem Blatt als Textdatei zu speichern. Mein Code ist unten und hat gerade C: \ Daten als Pfad. Was ich tun möchte, ist ein bisschen vor der "für jede" -Schleife, die den Benutzer auffordert, den Speicherpfad (ein Teamlaufwerk) auszuwählen, und dann führt die Schleife alle Dateien durch und exportiert sie in diesen Pfad. Kann mir jemand helfen?

Dank 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 

Answer 1

Siehe Beispiel Codepfad Auswahl UI zu starten.

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

können Sie eine inputbox verwenden, um dies zu erreichen:

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