Hacking a script - export workbook to .txt file with delimiter between cells
Hi again,
I had so much luck with everyone's fine responses today that I thought I would be so bold as to post an involved hack that I'm working towards.
I'm trying to hack together the following 2 scripts, with the hopes that I will be able to export an entire workbook to a .txt file with a user-defined delimiter inserted between cells, while stripping out any blank rows. I expect to have plenty of blank cells within certain rows with values sandwiched in between the blank cells, but I would like to strip out any rows that contain no values at all.
I have created this script some months ago, which provides examples of delimiter usage, as well as rows and column selections (I know I go a little overboard with the comments):
Code:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'ExportToTextFile - exports the Excel sheet or range of cells to the .txt file, using the
'user-defined separator character.
' Parameter Description:
' FName - The name of the file to which the data will be written. The file will be created if it does not exist.
' See AppendData below.
' Sep - The character that is to separate the elements on each row of the exported file.
' Typically, this is vbTab, a space, a comma, semicolor, or pipe ( | ). Any character may be used.
' SelectionOnly - If True, only the currently selected cells are exported.
' If False, the entire used range of the worksheet is exported.
' AppendData - If True and FName exists, data is written to the end of the text file, preserving the existing contents.
' If False, the existing contents of FName are destroyed and only the newly exported data will appear
' in the output file.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub ExportToTextFile(FName As String, _
Sep As String, SelectionOnly As Boolean, _
AppendData 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
Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile
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
If AppendData = True Then
Open FName For Append Access Write As #FNum
Else
Open FName For Output Access Write As #FNum
End If
For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = Chr(34) & Chr(34)
Else
CellValue = Cells(RowNdx, ColNdx).Text
End If
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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'END ExportToTextFile
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DoTheExport - prompts the user for the FileName and the delimiter
' character and then calls the ExportToTextFile procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub DoTheExport()
Dim FileName As Variant
Dim Sep As String
FileName = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="Text Files (*.txt),*.txt")
If FileName = False Then
''''''''''''''''''''''''''
'user cancelled export procedure, so get out
''''''''''''''''''''''''''
Exit Sub
End If
Sep = Application.InputBox("Enter a separator character.", Type:=2)
If Sep = vbNullString Then
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'user cancelled export procedure, so get out
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Exit Sub
End If
Debug.Print "FileName: " & FileName, "Separator: " & Sep
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FName = File Name field (leave this alone unless you want to hard code in the file name - i.e.:=CStr("FileName.txt"))
' Sep = Delimiter field (leave this alone unless you want to hard code in the delimiter - i.e.:=CStr("*"))
' Set 'SelectionOnly:=False' to export all data contained in the worksheet
' Set 'AppendData:=True' to add additional data to the end of an existing exported text file
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ExportToTextFile FName:=CStr(FileName), Sep:=CStr(Sep), _
SelectionOnly:=True, AppendData:=True
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END DoTheExport
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
This is the code that will export the entire workbook to a text file, that xld, mdmackillop, & Norie have helped me to get working today, (many thanks again to you 3 for your help):
Code:
' Description: Exports all sheets in the active workbook to a single text file
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub SaveAsTextFile()
Dim s As Worksheet
Dim d As DataObject
Set d = New DataObject
Open "c:\temp\mytest.txt" For Append As 1
For Each s In ThisWorkbook.Sheets
s.UsedRange.Copy
d.GetFromClipboard
Print #1, vbNewLine & s.Name & vbNewLine & String(Len(s.Name), "=")
Print #1, d.GetText
Next
Close 1
End Sub
I know this is quite extensive, I apologize for the length and involvement, but posting here does two things for me:
- It helps me to think through what I'm actually trying to do, and helps me to articulate my thoughts so others can understand, which in turn helps me to understand what it is I'm trying to do.
- Opens up the issue for feedback
Once the code is finalized, I'll post it for the community (with comments) so all can benefit if the need for this ever comes up.
Thanks for reading, I hope I'm not overstepping the bounds of posting,
~Chipley
