Forum Discussion
VBA-Excel weird behaviour on SaveAs Dialog - Read On - SOLVED but sad
Hey Jan. Thanks for getting back to me and yes it seems very weird given it is inside a variable and not a command/function of any kind. I really hope it is me. Just some quick background. The code snippet uses a field from a spreadsheet, but you can use a literal and see the same result.
This works fine, "H.csv", "Ho.csv", Hom.csv", even something like "myprefix_HomeServicesSKUMAP.csv" works. Just not anything that begins with "Home".
Essentially, the initial filename does not show if "Home" is the first four characters - makes no sense to me.
Sub ExportToCSVFile()
Dim src_ws As Worksheet
Dim create_csv As Worksheet
Dim rng As Range
Dim cell As Range
Dim rowIndex As Long
Dim colIndex As Long
Dim line As String
Dim delimiter As String
Dim csv_fileName As String
Dim expFile As Variant
Dim stream As Object ' ADODB.Stream
Dim currentUser As String
Dim spDirectory As String
Dim extractedCount As Integer
Dim outputSelection As String
Dim colMax As Integer
Dim filePath As Variant
On Error GoTo ErrorHandler
' Set the maximum number of columns to extract
colMax = 3
' Set the worksheet location for the input variables
Set create_csv = ThisWorkbook.Sheets("Create_CSVs")
' Set the worksheet name
Dim balloonToHelium_ws As String
balloonToHelium_ws = "BalloonToHeliumSKU"
' Get the file name
' you can substitute csv_fileName = "HomeServicesSKUMap.csv"
csv_fileName = create_csv.Range("B3").Value & ".csv"
' Ensure the file name is not empty
If Trim(csv_fileName) = ".csv" Then
MsgBox "File name cannot be empty.", vbExclamation
Exit Sub
End If
' Get the output selection
outputSelection = create_csv.Range("B7").Value
' Set the name of the worksheet that holds the data for export
Set src_ws = ThisWorkbook.Sheets(balloonToHelium_ws)
' Define the file path for the CSV file
If outputSelection = "My Choice" Then
filePath = Application.GetSaveAsFilename(InitialFileName:=csv_fileName, FileFilter:="CSV Files (*.csv), *.csv")
' Check if user cancelled the Save As dialog
If filePath = False Then
Exit Sub
Else ' assume we have a SharePoint location chosen. B8 is the SP location
currentUser = Environ("USERNAME")
spDirectory = create_csv.Range("B8").Value
filePath = "C:\Users\" & currentUser & "\OneDrive - your company\" & spDirectory & "\" & csv_fileName
End If
' Define the range
Set rng = src_ws.UsedRange ' Adjust as needed
' Define the custom delimiter
delimiter = ","
' Create the ADODB.Stream object
Set stream = CreateObject("ADODB.Stream")
stream.Type = 2 ' Specify stream type - we want to save text/string data.
stream.Charset = "UTF-8" ' Specify charset for the source text data.
' Open the stream
stream.Open
extractedCount = 0
' Loop through each row in the range - ignore rows 1 through 6
For rowIndex = 7 To rng.Rows.Count
line = ""
If rng.Cells(rowIndex, 1).Value <> "" Then
' Loop through each column in the row - only want first 'colMax' columns
For colIndex = 1 To colMax
' Get the cell value
Set cell = rng.Cells(rowIndex, colIndex)
line = line & cell.Value & IIf(colIndex < colMax, delimiter, "")
Next colIndex
' Write the line to the stream and add <CR><LF> at the end of the record
stream.WriteText line & vbCrLf
extractedCount = extractedCount + 1
End If
Next rowIndex
' Save the stream to the file
stream.SaveToFile filePath, 2 ' 2 = adSaveCreateOverWrite
' Close the stream
stream.Close
' Notify the user that the export is complete
MsgBox "File " & csv_fileName & " has been exported to " & filePath & " directory." & vbCrLf & "Rows extracted = " & extractedCount, vbInformation
Exit Sub
ErrorHandler:
If Not stream Is Nothing Then
If stream.State = 1 Then stream.Close ' Ensure the stream is closed if an error occurs
End If
MsgBox "An unexpected error occurred: " & Err.Description & " (Error Number: " & Err.Number & ")", vbCritical
End Sub
NotSoFastEddie Perhaps you can use this function instead of GetSaveAsFileName?
Function GetAFileName(initialName As String)
Dim fd As FileDialog
Dim i As Long
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.InitialFileName = initialName
For i = 1 To .Filters.Count
If LCase(.Filters(i).Description) Like "csv (comma delimited)*" Then
.FilterIndex = i
Exit For
End If
Next
If .Show Then
GetAFileName = .SelectedItems(1)
End If
End With
End Function
- NotSoFastEddieJun 20, 2024Copper ContributorThanks Jan, I will give it a try