Excel 2007 Power Programming with VBA (Mr. Spreadsheets Bookshelf)

This section contains a number of examples that demonstrate various techniques that manipulate text files.

Importing data in a text file

The following example reads a text file and then places each line of data in a single cell (beginning with the active cell ):

Sub ImportData() Open "c:\data\textfile.txt" For Input As #1 r = 0 Do Until EOF(1) Line Input #1, data ActiveCell.Offset(r, 0) = data r = r + 1 Loop Close #1 End Sub

In most cases, this procedure won't be very useful because each line of data is simply dumped into a single cell. It would be easier to just open the text file directly by using Office Open.

Exporting a range to a text file

The example in this section writes the data in a selected worksheet range to a CSV text file. Excel, of course, can export data to a CSV file, but it exports the entire worksheet. This macro works with a specified range of cells .

Sub ExportRange() Dim Filename As String Dim NumRows As Long, NumCols As Integer Dim r As Long, c As Integer Dim Data Dim ExpRng As Range Set ExpRng = Selection NumCols = ExpRng.Columns.Count NumRows = ExpRng.Rows.Count Filename = Application.DefaultFilePath & "\textfile.csv" Open Filename For Output As #1 For r = 1 To NumRows For c = 1 To NumCols Data = ExpRng.Cells(r, c).Value If IsNumeric(Data) Then Data = Val(Data) If IsEmpty(ExpRng.Cells(r, c)) Then Data = "" If c <> NumCols Then Write #1, Data; Else Write #1, Data End If Next c Next r Close #1 End Sub

Notice that the procedure uses two Write # statements. The first statement ends with a semicolon, so a carriage return/ linefeed sequence is not written. For the last cell in a row, however, the second Write # statement does not use a semicolon, which causes the next output to appear on a new line.

I use a variable named Data to store the contents of each cell. If the cell is numeric, the variable is converted to a value. This step ensures that numeric data will not be stored with quotation marks. If a cell is empty, its Value property returns . Therefore, the code also checks for a blank cell (by using the IsEmpty function) and substitutes an empty string instead of a zero.

Figure 27-5 shows the contents of the resulting file, viewed in Windows Notepad.

Figure 27-5: This text file was generated by VBA.

CD-ROM  

This example and the example in the next section are available on the companion CD-ROM. The filename is  export and import csv.xlsm .

Importing a text file to a range

The example in this section reads the CSV file created in the previous example and then stores the values beginning at the active cell in the active worksheet. The code reads each character and essentially parses the line of data, ignoring quote characters and looking for commas to delineate the columns.

Sub ImportRange() Dim ImpRng As Range Dim Filename As String Dim r As Long, c As Integer Dim txt As String, Char As String * 1 Dim Data Dim i As Integer Set ImpRng = ActiveCell On Error Resume Next Filename = Application.DefaultFilePath & "\textfile.csv" Open Filename For Input As #1 If Err <> 0 Then MsgBox "Not found: " & Filename, vbCritical, "ERROR" Exit Sub End If r = 0 c = 0 txt = "" Application.ScreenUpdating = False Do Until EOF(1) Line Input #1, Data For i = 1 To Len(Data) Char = Mid(Data, i, 1) If Char = "," Then 'comma ActiveCell.Offset(r, c) = txt c = c + 1 txt = "" ElseIf i = Len(Data) Then 'end of line If Char <> Chr(34) Then txt = txt & Char ActiveCell.Offset(r, c) = txt txt = "" ElseIf Char <> Chr(34) Then txt = txt & Char End If Next i c = 0 r = r + 1 Loop Close #1 Application.ScreenUpdating = True End Sub

Note  

The preceding procedure has a flaw: It doesn't handle data that contains a comma or a quote character. In addition, an imported date will be surrounded by number signs: for example, #2007-05-12# .

Logging Excel usage

The example in this section writes data to a text file every time Excel is opened and closed. In order for this to work reliably, the procedure must be located in a workbook that's opened every time you start Excel. The Personal Macro Workbook is an excellent choice.

The following procedure, stored in the code module for the ThisWorkbook object, is executed when the file is opened:

Private Sub Workbook_Open() Open Application.Path & "\excelusage.txt" For Append As #1 Print #1, "Started " & Now Close #1 End Sub

The procedure appends a new line to a file named excelusage.txt . The new line contains the current date and time and might look something like this:

Started 11/16/09 9:27:43 PM

The following procedure is executed before the workbook is closed. It appends a new line that contains the word Stopped along with the current date and time.

Private Sub Workbook_BeforeClose(Cancel As Boolean) Open Application.Path & "\excelusage.txt" _ For Append As #1 Print #1, "Stopped " & Now Close #1 End Sub

CROSS-REFERENCE  

Refer to chapter 19 for more information about event handler procedures such as Workbook_Open and Workbook_BeforeClose .

Filtering a text file

The example in this section demonstrates how to work with two text files at once. The FilterFile procedure that follows reads a text file ( infile.txt ) and copies only the rows that contain a specific text string to a second text file ( output.txt ).

Sub FilterFile() Open ThisWorkbook.Path & "\infile.txt" For Input As #1 Open Application.DefaultFilePath & "\output.txt" For Output As #2 TextToFind = "January" Do Until EOF(1) Line Input #1, data If InStr(1, data, TextToFind) Then Print #2, data End If Loop Close #1 End Sub

CD-ROM  

This example, named  filter text file.xlsm , is available on the companion CD-ROM.

Exporting a range to HTML format

The example in this section demonstrates how to export a range of cells to an HTML file. An HTML file, as you might know, is simply a text file that contains special formatting tags that describe how the information will be presented in a Web browser.

Why not use Excel's Office Save As command and choose the Web Page file type? The procedure listed here has a distinct advantage: It does not produce bloated HTML code. For example, I used the ExportToHTML procedure to export a range of 70 cells. The file size was 2.6KB. Then I used Excel's Office Save as Web Page command to export the sheet. The result was 15.8KB - more than six times larger.

But, on the other hand, the ExportToHTML procedure does not maintain all the cell formatting. In fact, the only formatting information that it produces is bold, italic, and horizontal alignment. However, the procedure is good enough for many situations, and it serves as the basis for additional enhancements.

Sub ExportToHTML() Dim Filename As Variant Dim TDOpenTag As String, TDCloseTag As String Dim CellContents As String Dim Rng As Range Dim r As Long, c As Integer ' Use the selected range of cells Set Rng = Application.Intersect(ActiveSheet.UsedRange, Selection) If Rng Is Nothing Then MsgBox "Nothing to export.", vbCritical Exit Sub End If ' Get a file name Filename = Application.GetSaveAsFilename( _ InitialFileName:="myrange.htm", _ fileFilter:="HTML Files(*.htm), *.htm") If Filename = False Then Exit Sub ' Open the text file Open Filename For Output As #1 ' Write the tags Print #1, "<HTML>" Print #1, "<TABLE BORDER=0 CELLPADDING=3>" ' Loop through the cells For r = 1 To Rng.Rows.Count Print #1, "<TR>" For c = 1 To Rng.Columns.Count Select Case Rng.Cells(r, c).HorizontalAlignment Case xlHAlignLeft TDOpenTag = "<TD ALIGN=LEFT>" Case xlHAlignCenter TDOpenTag = "<TD ALIGN=CENTER>" Case xlHAlignGeneral If IsNumeric(Rng.Cells(r, c)) Then TDOpenTag = "<TD ALIGN=RIGHT>" Else TDOpenTag = "<TD ALIGN=LEFT>" End If Case xlHAlignRight TDOpenTag = "<TD ALIGN=RIGHT>" End Select TDCloseTag = "</TD>" If Rng.Cells(r, c).Font.Bold Then TDOpenTag = TDOpenTag & "<B>" TDCloseTag = "</B>" & TDCloseTag End If If Rng.Cells(r, c).Font.Italic Then TDOpenTag = TDOpenTag & "<I>" TDCloseTag = "</I>" & TDCloseTag End If CellContents = Rng.Cells(r, c).Text Print #1, TDOpenTag & CellContents & TDCloseTag Next c Print #1, "</TR>" Next r ' Close the table Print #1, "</TABLE>" Print #1, "</HTML>" ' Close the file Close #1 ' Tell the user MsgBox Rng.Count & " cells were exported to " & Filename End Sub

The procedure starts by determining the range to export. This is based on the intersection of the selected range and the used area of the worksheet. This ensures that entire rows or columns are not processed . Next, the user is prompted for a filename, and the text file is opened. The bulk of the work is done within two For-Next loops . The code generates the appropriate HTML tags and writes the information to the text file. The only complicated part is determining the cell's horizontal alignment. (Excel doesn't report this information directly.) Finally, the file is closed, and the user sees a summary message.

Figure 27-6 shows a range in a worksheet, and Figure 27-7 shows how it looks in a Web browser after being converted to HTML.

Figure 27-6: A worksheet range, ready to be converted to HTML.

Figure 27-7: The worksheet data after being converted to HTML.

CD-ROM  

This example, named  export to HTML.xlsm , is available on the companion CD-ROM.

Exporting a range to an XML file

This example exports an Excel range to a simple XML data file. As you might know, an XML file uses tags to wrap each data item. The procedure in this section uses the labels in the first row as the XML tags. Figure 27-8 shows the range in a worksheet table, and Figure 27-9 shows the XML file displayed in a Web browser.

Figure 27-8: The data in this range will be converted to XML.

Figure 27-9: The worksheet data after being converted to XML.

Note  

Although Excel 2003 introduced improved support for XML files, it can't create an XML file from an arbitrary range of data unless you have a map file (schema) for the data.

The ExportToXML procedure follows. You'll notice that it has a quite a bit in common with the ExportToHTML procedure in the previous section.

Sub ExportToXML() Dim Filename As Variant Dim Rng As Range Dim r As Long, c As Long ' Set the range Set Rng = Range("Table1[#All]") ' Get a file name Filename = Application.GetSaveAsFilename( _ InitialFileName:="myrange.xml", _ fileFilter:="XML Files(*.xml), *.xml") If Filename = False Then Exit Sub ' Open the text file Open Filename For Output As #1 ' Write the <xml> tags Print #1, "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" Print #1, "<EmployeeList xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">" ' Loop through the cells For r = 2 To Rng.Rows.Count Print #1, "<Employee>" For c = 1 To Rng.Columns.Count Print #1, "<" & Rng.Cells(1, c) & ">"; If IsDate(Rng.Cells(r, c)) Then Print #1, Format(Rng.Cells(r, c), "yyyy-mm-dd"); Else Print #1, Rng.Cells(r, c).Text; End If Print #1, "</" & Rng.Cells(1, c) & ">" Next c Print #1, "</Employee>" Next r ' Close the table Print #1, "</EmployeeList>" ' Close the file Close #1 ' Tell the user MsgBox Rng.Rows.Count - 1 & " records were exported to " & Filename End Sub

CD-ROM  

This example, named  export to XML.xlsm , is available on the companion CD-ROM.

The exported XML file can be opened with Excel. When opening an XML file, you'll see the dialog box shown in Figure 27-10. If you choose the As an XML Table option, the file will be displayed as a table. Keep in mind that any formulas in the original table are not preserved.

Figure 27-10: When opening an XML file, Excel offers three options.

Категории