K
ker_01
I have a large source data file that I need to incorporate into my Excel
worksheet.
If I record a macro while opening the file, I get the following; each field
has an indicator that makes it text, date, or whatever format I selected.
However, this opens the file as a new Excel sheet, whereas I need to just
load it directly into memory.
Sub OpenCOLAStxtFile()
Workbooks.OpenText FileName:= _
\\SharedNetworkDrive\Folder\Subfolder\Filename.txt", Origin:=437, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1),
Array(40 _
, 1), Array(51, 1), Array(73, 1), Array(94, 1), Array(135, 2),
Array(176, 1), Array(217, 2), _
Array(238, 1), Array(249, 1), Array(259, 1), Array(270, 1),
Array(292, 1), Array(313, 1), _
Array(354, 1), Array(394, 1), Array(436, 2), Array(477, 2),
Array(498, 2), Array(539, 3), _
Array(550, 1), Array(562, 3), Array(574, 3), Array(586, 3),
Array(598, 1), Array(600, 1), _
Array(602, 1), Array(604, 1), Array(625, 1), Array(637, 1),
Array(648, 1), Array(689, 1), _
Array(730, 1), Array(737, 1)), TrailingMinusNumbers:=True
Range("A2").Select
End Sub
The second macro (below) is what I use to open text files and parse out the
contents into memory (or dump to a sheet). Is there an optional parameter on
the commands that read the text file that would make it easier to force some
of the columns formats away from what occurs with general formatting? Heck,
is there a better way altogether to pull in the contents of a fixed-width
delimited text file? This seems clunky to me; I'd rather just read a line at
a time and split it, if that makes more sense.
Thanks!
Keith
Sub ReadCOLAStxt()
Global Const COLAStxt = "BACKLOGALL.TXT"
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.StatusBar = "Loading Raw Data Files: " & COLAStxt
Dim LineofText As String
Dim Paragraphs() As String
Dim rw As Long
Dim lIndex As Long
Dim mywrksht As Worksheet
COLAStxt_Parse = Array(0, 40, 51, 73, 94, 135, 176, 217, 238, 249, 259, 270,
292, 313, 354, 394, 436, 477, 498, 539, 550, 562, 574, 586, 598, 600, 602,
604, 625, 637, 648, 689, 730, 738, 0)
COLAStxt_MaxCols = 33
Dim oFS As Object
Dim oFile As Object
Set oFS = CreateObject("Scripting.FilesystemObject")
On Error GoTo COLAStxtNoFile:
UseDataFileLocation = DataFileLocation & COLAStxt
Set oFile = oFS.getfile(UseDataFileLocation)
On Error GoTo 0
If Not oFile Is Nothing Then
'get date of file
DateCOLAStxtModified = CDate(oFile.DateLastModified)
COLAStxtOldDate = GetProperty("COLAStxtDate",
PropertyLocationCustom)
Else
Exit Sub
End If
On Error GoTo 0
' LongFN = DataFileLocation & COLAStxt
rw = 0
Dim X As Long
Dim FileLines() As String
FileLines = SplitFileIntoLines(DataFileLocation & COLAStxt)
For X = 0 To UBound(FileLines)
TextLineStartChar = Left(Trim(FileLines(X)), 1)
If (Len(FileLines(X)) = 0) Or (TextLineStartChar = "=") Then
'do nothing
Else
rw = rw + 1
Application.StatusBar = "Loading " & COLAStxt & " Row: " &
CStr(rw)
' now parse LineofText according to the column widths and
' put the values in an array.
'skip header rows, then process the rest
If rw > 3 Then
For j = 1 To COLAStxt_MaxCols
ParseStart = COLAStxt_Parse(j)
ParseEnd = COLAStxt_Parse(j + 1)
If ParseEnd > 0 Then
TotalDataArray(j, rw) = Trim(Mid(FileLines(X),
ParseStart, ParseEnd - ParseStart))
ConvertCol (j)
mywrksht.Range(Usecol & CStr(rw - 5)).Value =
TotalDataArray(j, rw)
Else
Exit For
End If
Next
End If
End If
Next
SetProperty "COLAStxtDate", PropertyLocationCustom,
DateCOLAStxtModified, False
Application.StatusBar = False
strNow = Format(Month(Date), "00") & Format(Day(Date), "00") &
Format(Year(Date), "0000")
Name DataFileLocation & COLAStxt As DataFileLocation &
"OldRawDataFiles\" & "COLAStxt_" & strNow & ".txt"
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
COLAStxtNoFile:
'error handling code
MsgBox "COLAStxt.txt was not found at the expected location. Unable to
load updated COLAStxt data." & vbCrLf & vbCrLf & _
"The Colas raw text file is removed once it has been processed, so if
the 'upload' has already occured today you may ignore this error.", , "File
Not Found"
Resume Next
End Sub
worksheet.
If I record a macro while opening the file, I get the following; each field
has an indicator that makes it text, date, or whatever format I selected.
However, this opens the file as a new Excel sheet, whereas I need to just
load it directly into memory.
Sub OpenCOLAStxtFile()
Workbooks.OpenText FileName:= _
\\SharedNetworkDrive\Folder\Subfolder\Filename.txt", Origin:=437, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1),
Array(40 _
, 1), Array(51, 1), Array(73, 1), Array(94, 1), Array(135, 2),
Array(176, 1), Array(217, 2), _
Array(238, 1), Array(249, 1), Array(259, 1), Array(270, 1),
Array(292, 1), Array(313, 1), _
Array(354, 1), Array(394, 1), Array(436, 2), Array(477, 2),
Array(498, 2), Array(539, 3), _
Array(550, 1), Array(562, 3), Array(574, 3), Array(586, 3),
Array(598, 1), Array(600, 1), _
Array(602, 1), Array(604, 1), Array(625, 1), Array(637, 1),
Array(648, 1), Array(689, 1), _
Array(730, 1), Array(737, 1)), TrailingMinusNumbers:=True
Range("A2").Select
End Sub
The second macro (below) is what I use to open text files and parse out the
contents into memory (or dump to a sheet). Is there an optional parameter on
the commands that read the text file that would make it easier to force some
of the columns formats away from what occurs with general formatting? Heck,
is there a better way altogether to pull in the contents of a fixed-width
delimited text file? This seems clunky to me; I'd rather just read a line at
a time and split it, if that makes more sense.
Thanks!
Keith
Sub ReadCOLAStxt()
Global Const COLAStxt = "BACKLOGALL.TXT"
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.StatusBar = "Loading Raw Data Files: " & COLAStxt
Dim LineofText As String
Dim Paragraphs() As String
Dim rw As Long
Dim lIndex As Long
Dim mywrksht As Worksheet
COLAStxt_Parse = Array(0, 40, 51, 73, 94, 135, 176, 217, 238, 249, 259, 270,
292, 313, 354, 394, 436, 477, 498, 539, 550, 562, 574, 586, 598, 600, 602,
604, 625, 637, 648, 689, 730, 738, 0)
COLAStxt_MaxCols = 33
Dim oFS As Object
Dim oFile As Object
Set oFS = CreateObject("Scripting.FilesystemObject")
On Error GoTo COLAStxtNoFile:
UseDataFileLocation = DataFileLocation & COLAStxt
Set oFile = oFS.getfile(UseDataFileLocation)
On Error GoTo 0
If Not oFile Is Nothing Then
'get date of file
DateCOLAStxtModified = CDate(oFile.DateLastModified)
COLAStxtOldDate = GetProperty("COLAStxtDate",
PropertyLocationCustom)
Else
Exit Sub
End If
On Error GoTo 0
' LongFN = DataFileLocation & COLAStxt
rw = 0
Dim X As Long
Dim FileLines() As String
FileLines = SplitFileIntoLines(DataFileLocation & COLAStxt)
For X = 0 To UBound(FileLines)
TextLineStartChar = Left(Trim(FileLines(X)), 1)
If (Len(FileLines(X)) = 0) Or (TextLineStartChar = "=") Then
'do nothing
Else
rw = rw + 1
Application.StatusBar = "Loading " & COLAStxt & " Row: " &
CStr(rw)
' now parse LineofText according to the column widths and
' put the values in an array.
'skip header rows, then process the rest
If rw > 3 Then
For j = 1 To COLAStxt_MaxCols
ParseStart = COLAStxt_Parse(j)
ParseEnd = COLAStxt_Parse(j + 1)
If ParseEnd > 0 Then
TotalDataArray(j, rw) = Trim(Mid(FileLines(X),
ParseStart, ParseEnd - ParseStart))
ConvertCol (j)
mywrksht.Range(Usecol & CStr(rw - 5)).Value =
TotalDataArray(j, rw)
Else
Exit For
End If
Next
End If
End If
Next
SetProperty "COLAStxtDate", PropertyLocationCustom,
DateCOLAStxtModified, False
Application.StatusBar = False
strNow = Format(Month(Date), "00") & Format(Day(Date), "00") &
Format(Year(Date), "0000")
Name DataFileLocation & COLAStxt As DataFileLocation &
"OldRawDataFiles\" & "COLAStxt_" & strNow & ".txt"
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
COLAStxtNoFile:
'error handling code
MsgBox "COLAStxt.txt was not found at the expected location. Unable to
load updated COLAStxt data." & vbCrLf & vbCrLf & _
"The Colas raw text file is removed once it has been processed, so if
the 'upload' has already occured today you may ignore this error.", , "File
Not Found"
Resume Next
End Sub