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):
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):'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '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 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
I know this is quite extensive, I apologize for the length and involvement, but posting here does two things for me:' 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
- 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
Reply With Quote
