VBA - Modify existing code that exports range to file, to prompt for location to save file

[AGrayson84]

Hi everyone, I have some VBA code that is used to export a specific cell range to a .PS1 file, which basically makes a PowerShell output file that I can run to do some scripts. I have the below VBA that designates the filename and the file location, but I would like to alter the script to prompt the user for the file location, while retaining the filename designation along with everything else in the VBA code. Would anyone mind helping me alter my below code to prompt for the file location? Thank you in advance.

Sub ExportToPS1()
If Len(Dir("N:\NDA\1_Add_To_Scanning", vbDirectory)) = 0 Then

   MkDir "N:\NDA\1_Add_To_Scanning"

End If
    Dim r As Range, c As Range
    Dim sTemp As String
    Dim AddToScanningFilename As String
    Dim AddToScanningPath As String
    AddToScanningPath = "N:\NDA\1_Add_To_Scanning\"
    AddToScanningFilename = Worksheets("Input").Range("A8").Value & "_" & Worksheets("Input").Range("B8").Value & "_" & Format$(Date, "mmddyyyy") & "_" & "Add_To_Scanning_VLAN_999" & ".ps1"

    Open AddToScanningPath & AddToScanningFilename For Output As #1
    For Each r In Range("B2:B200")
        sTemp = ""
        For Each c In r.Cells
            sTemp = sTemp & c.Text & Chr(9)
        Next c

        'Get rid of trailing tabs
        While Right(sTemp, 1) = Chr(9)
            sTemp = Left(sTemp, Len(sTemp) - 1)
        Wend
        Print #1, sTemp
    Next r
    Close #1
End Sub

 

[dmt32]

Hi,
see if this update to your code does what you want

Sub ExportToPS1()
    Dim r As Range, c As Range
    Dim sTemp As String
    
    Dim AddToScanningFilename As String
    Dim AddToScanningPath As Variant
    
    'AddToScanningPath = "N:\NDA\1_Add_To_Scanning\"
    
    AddToScanningPath = GetFolder
'cancel pressed
    If IsError(AddToScanningPath) Then Exit Sub
    
    AddToScanningFilename = Worksheets("Input").Range("A8").Value & "_" & Worksheets("Input").Range("B8").Value & "_" & Format$(Date, "mmddyyyy") & "_" & "Add_To_Scanning_VLAN_999" & ".ps1"


    Open AddToScanningPath & AddToScanningFilename For Output As #1
    For Each r In Range("B2:B200")
        sTemp = ""
        For Each c In r.Cells
            sTemp = sTemp & c.Text & Chr(9)
        Next c


        'Get rid of trailing tabs
        While Right(sTemp, 1) = Chr(9)
            sTemp = Left(sTemp, Len(sTemp) - 1)
        Wend
        Print #1, sTemp
    Next r
    Close #1
End Sub

Copy function to a standard module

Function GetFolder(Optional ByVal FolderPath As Variant) As Variant
    Dim Folder As FileDialog
    Dim Item As Variant
    
    If IsMissing(FolderPath) Then FolderPath = ThisWorkbook.Path
    Set Folder = Application.FileDialog(msoFileDialogFolderPicker)
    
    With Folder
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .ButtonName = "Select Folder"
        .InitialFileName = FolderPath
'cancel pressed
        If .Show <> -1 Then Item = CVErr(10): GoTo ExitFunction
'folder selected
        Item = .SelectedItems(1) & "\"
    End With
    
ExitFunction:
    GetFolder = Item
    Set Folder = Nothing
End Function

Function has option to specify default path otherwise the path for the workbook is used.

Hope helpful

Dave