VBA Programming Tutorial for a Custom Text File Import
In this VBA programming tutorial you will see how to import a text file that for one reason or another can't be imported to your satisfaction into Excel. An example would be when each row in the test file does not represent a logical row in Excel...
This could be a file that has sections based on the date and rows that constitute the time of day of an action. If there are many actions for each day, as you scroll down looking at the actions, you would not have the date visible. You want the date of the action to appear in each row. This can occur in "log" files that applications can create.
To start the VBA programming tutorial, let's take an example text file, "example.txt"
Also, for this VBA programming tutorial you will need to set a Reference. In the VBA Editor's Tools menu, click References... scroll down to "Microsoft Scripting Runtime" and choose it. You need to do this so that we can access the file system.
Wed Apr 05 2006In Excel, we want the date, time, file, and user.
11:05:18 1: file: This user: carol
17:25:27 1: file: could user marla
17:57:55 1: file: be user tim
21:01:45 1: file: file user mark
21:10:32 1: file: that user carol
21:19:25 1: file: has user tim
Thu Apr 06 2006
10:00:44 1: file: sections user marla
15:05:25 1: file: file user mark
16:03:31 1: file: date user marla
16:33:21 1: file: rows 21 user tim
Fri Apr 07 2006
09:45:50 1: file: that user mark
09:51:56 1: file could user carol
10:05:16 1: file: sections user marla
The macro/Sub will find the text file in the same folder that this workbook is opened in, create a new workbook, and it will save the workbook with the same name as the folder when the import is complete.
We can import the data like this...
Option Explicit
Sub ImportLog()
Dim oFld As Folder, oTS As TextStream
Dim sSavePath As String, oFil As File
Dim blHaveFile As Boolean, sFilePath As String
Dim sCurrentLine As String
Dim sYr As String, sMo As String, sDay As String
Dim sDate As String, sMoOld As String
Dim oFSO As New FileSystemObject, xlRow As Long
'Is there a text file in the folder?
blHaveFile = False
'Add a workbook to import into
Workbooks.Add
'Widen the columns
Columns("A:A").ColumnWidth = 15
Columns("B:B").ColumnWidth = 15
Columns("C:C").ColumnWidth = 15
Columns("D:D").ColumnWidth = 15
'Label the columns
Range("A1") = "Date"
Range("B1") = "Time"
Range("C1") = "File"
Range("D1") = "User"
'You can format the columns
'Here, we format them all the same by selecting them all
'like CTRL + a
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Deselect the cells
Range("A1").Select
'Since we declared the oFSO object with the New keyword...
'Dim oFSO As New FileSystemObject
'we don't need a separate Set statement and can just use it
'It will be created on the fly.
Set oFld = oFSO.GetFolder(Application.Workbooks(1).Path)
'Loop through the files looking for a text file.
For Each oFil In oFld.Files
If Right(oFil.Name, 3) = "txt" Then
'If we found one, we set the boolean hlHaveFile variable to True,
'save the path, and exit the loop.
blHaveFile = True
sFilePath = oFil.Path
Exit For
End If
Next
sSavePath = oFld.Path
'Create the file name for saving the new Workbook.
sSavePath = sSavePath & "" & Right(sSavePath, Len(sSavePath) - _
InStrRev(sSavePath, "")) & ".xls"
'If blHaveFile is still False, stop the code.
If blHaveFile = False Then
MsgBox "No txt file found."
Set oFld = Nothing
End
End If
'Set the TextStream object to the contents of the text file.
Set oTS = oFSO.OpenTextFile(sFilePath, ForReading)
'The first Excel row has the column headings, start writing
'in row 2.
xlRow = 2
'Loop through all the lines in the file.
Do Until oTS.AtEndOfStream
sCurrentLine = oTS.ReadLine
'Check if the row contain a date or data.
'If the first character is not a number and the line is not blank.
If (Not IsNumeric(Left(sCurrentLine, 1))) And _
Len(Trim(sCurrentLine)) Then
sCurrentLine = Trim(sCurrentLine)
sYr = Mid(sCurrentLine, 12, 4)
sDay = Mid(sCurrentLine, 9, 2)
sMo = Mid(sCurrentLine, 5, 3)
'Change month's name to its number.
Select Case sMo
Case "Jan"
sMo = "01"
Case "Feb"
sMo = "02"
Case "Mar"
sMo = "03"
Case "Apr"
sMo = "04"
Case "May"
sMo = "05"
Case "Jun"
sMo = "06"
Case "Jul"
sMo = "07"
Case "Aug"
sMo = "08"
Case "Sep"
sMo = "09"
Case "Oct"
sMo = "10"
Case "Nov"
sMo = "11"
Case "Dec"
sMo = "12"
End Select
'String the components together to form a formatted date.
sDate = sDay & "/" & sMo & "/" & sYr
Else
'Check that the line starts with a numeral.
If IsNumeric(Left(sCurrentLine, 1)) Then
If InStr(sCurrentLine, "file:") Then
ActiveSheet.Cells(xlRow, 1).Value = sDate
'Extract each piece of data from the Mid(dle) of the line.
ActiveSheet.Cells(xlRow, 2).Value = Left(sCurrentLine, 8)
'In a previous VBA programming tutorial we covered String Functions
'such as Mid, Instr, and Trim.
ActiveSheet.Cells(xlRow, 3).Value = _
Trim(Mid(sCurrentLine, InStr(sCurrentLine, "file:") + 6, _
InStr(sCurrentLine, "user:") - _
(InStr(sCurrentLine, "file:") + 6)))
ActiveSheet.Cells(xlRow, 4).Value = _
Trim(Mid(sCurrentLine, InStr(sCurrentLine, "user:") + 6, _
InStr(sCurrentLine, ",") - _
(InStr(sCurrentLine, "user:") + 6)))
xlRow = xlRow + 1
End If
End If
End If
Loop
oTS.Close
ActiveWorkbook.SaveAs sSavePath
Set oFSO = Nothing
MsgBox "done"
Set oFld = Nothing
Set oTS = Nothing
End Sub
This site is powered by Site Build It!. If you enjoy it, please check out the
Site Build It homepage to learn more and on how to build a success-guaranteed site with no technical skills.
Return from VBA Programming Tutorial to Free VBA Tutorials
Return from VBA Programming Tutorial to our Homepage
