I took your code and modified it and added it to my code but can't get it to work. It goes through the save process (pick location and filename, choose delimiter character) but doesn't save the file or change the format for the cells. Here is what I have:
Public Sub ExportToTextFile(FName As String, Sep As String, SelectionOnly As Boolean)
Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String
Dim Cell As Range
Dim Ext As String
Dim Filename As String
Dim Filepath As String
Dim Rng As Range
Dim Wkb As Workbook
Dim Wks As Worksheet
Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile
Set Rng = Wks.Range("A1", Wks.Cells(1, Wks.UsedRange.Column))
If Wks.UsedRange.Rows.Count > 1 Then
For Each Cell In Rng
If LCase(Cell) Like "*zip4*" Then
Cell.EntireColumn.Cells.NumberFormat = "0000"
Else
If LCase(Cell) Like "*zip*" Then
Cell.EntireColumn.Cells.NumberFormat = "00000"
End If
End If
Next Cell
End If
If SelectionOnly = True Then
With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
Else
With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
End If
Open FName For Output Access Write As #FNum
For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = ""
Else
CellValue = Cells(RowNdx, ColNdx).text
End If
CellValue = Replace(CellValue, vbCrLf, "")
CellValue = Replace(CellValue, vbCr, "")
CellValue = Replace(CellValue, vbLf, "")
'CellValue = UCase(CellValue) (This was causing the upper case issue for .jpg)
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum
End Sub
Public Sub DoTheExport()
Dim FName As Variant
Dim Sep As String
FName = Application.GetSaveAsFilename()
If FName = False Then
MsgBox "You didn't select a file"
Exit Sub
End If
Sep = InputBox("Enter a single delimiter character (e.g., comma or semi-colon)", "Export To Text File")
ExportToTextFile CStr(FName), Sep, MsgBox("Do You Want To Export The Entire Worksheet?", vbYesNo, "Export To Text File") = vbNo
End Sub
Bookmarks