by Andrew Rachmiel (1 Submission)
Category: String Manipulation
Compatability: VB Script
Difficulty: Unknown Difficulty
Originally Published: Mon 2nd July 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This code takes a semicolon (;) delimited text file and transposes the rows and columns into an Excel spreadsheet
VBcoders
'* FUNCTION TO OBTAIN THE DELIMITED FIELD WITHIN A TEXT STRING *
Function GetDelimitedField(FieldNum As Integer, _
DelimitedString As String, Delimiter As String) As String
'**********************************************************************
'* Variable declarations *
'**********************************************************************
Dim NewPos As Integer '* Holds the new position in the delimited string
Dim FieldCounter As Integer '* Holds the count of which field we're in
Dim FieldData As String '* Holds the delimited item to be returned
Dim RightLength As Integer '* Holds the length of the delimited item
Dim NextDelimiter As Integer '* Holds the character position of the delimiter
'* within FieldData
'**********************************************************************
'* Test to see if the String is empty, the delimeter is not specified *
'* or the delimited item is 0. If any of these are true, the *
'* GetDelimitedField is set to a blank string "" and the function is *
'* immediately exited *
'**********************************************************************
If (DelimitedString = "") Or (Delimiter = "") Or (FieldNum = 0) Then
GetDelimitedField = ""
Exit Function
End If
'**********************************************************************
'* Set the intial value of the NewPos to 1 and the Field Counter to 1 *
'**********************************************************************
NewPos = 1
FieldCounter = 1
'**********************************************************************
'* The following loop continues as long as the field we're in is less *
'* than the the field we have fed the function to find AND the *
'* position of the delimited string is not equal to 0 *
'* *
'* Within the loop, as long as the position is not equal to 0, we *
'* continue to increase the field we're in and the position of the *
'* string. Untimately we will find the delimited field that we've *
'* passed into the function *
'**********************************************************************
While (FieldCounter < FieldNum) And (NewPos <> 0)
NewPos = Instr(NewPos, DelimitedString, Delimiter, vbTextCompare)
If NewPos <> 0 Then
FieldCounter = FieldCounter + 1
NewPos = NewPos + 1
End If
Wend
'**********************************************************************
'* Now that we've identified the delimited field we're looking for, *
'* the field is obtained and returned as the GetDelimitedField *
'**********************************************************************
RightLength = Len(DelimitedString) - NewPos + 1
FieldData = Right$(DelimitedString, RightLength)
NextDelimiter = Instr(1, FieldData, Delimiter, vbTextCompare)
If NextDelimiter <> 0 Then
FieldData = Left$(FieldData, NextDelimiter - 1)
End If
GetDelimitedField = FieldData
End Function
'* MAIN SECTION OF CODE THAT STATES WHERE THE INPUT AND OUTPUT FILES ARE *
'* STORED, AS WELL AS WHAT THE DELIMITER IS *
Sub main()
'**********************************************************************
'* Variable declarations *
'**********************************************************************
Dim myArray() As String '* Array to hold each line of text from
'* the input file
Dim createdArray() As String '* Array to hold each delimited text item
'* returned from the function call
Dim iCounter As Integer '* Counter used to go through each line
'* of the input file
Dim jCounter As Integer '* Counter used to go through each delimited
'* field
Dim FieldText As String '* String to hold each delimited text item
'* returned from the function call
Dim Delimiter As String '* String to represent the Delimiter
Dim LineDataIn As String '* String holding each line from the input file
Dim Column As String '* String representing the column in Excel
Dim columnCounter As Integer '* Numeric representation of the column in
'* Excel. This item is converted from Ascii
'* to a character
Dim ExcelApp As Object '* Represents the Excel Application
Set ExcelApp = CreateObject("Excel.Application")
'**********************************************************************
'* Assign an arbitrary number to initialize FieldText *
'**********************************************************************
FieldText = "initial Field Text"
Delimiter = ";"
'**********************************************************************
'* Set the ColumnCounter to 65, which is the Ascii value for A, which *
'* is the first column in an Excel Spreadsheet *
'**********************************************************************
columnCounter = 65
'**********************************************************************
'* Establish the Input file and opens Output file. Note that the *
'* output file must already exist or the code will fail. Once the *
'* output file is opened (the spreadsheet), all contents are wiped *
'* out in order to start from a new sheet *
'**********************************************************************
Open "c:\Temp\UserClass1.txt" For Input As #1
ExcelApp.Workbooks.Open "c:\temp\test.xls"
ExcelApp.Cells.Select
ExcelApp.Selection.ClearContents
ExcelApp.Range("A1").Select
'**********************************************************************
'* Body of main that loops until the last line of the input file. *
'* The code reads in each line of the input file and parses through *
'* it in order to pull out all of the delimited fields. As it cycles *
'* through the string, it places each field into the next cell in the *
'* spreadsheet (i.e. A1, A2, A3.....). Once it gets to the end of *
'* the line, it goes to the next line and changes the cell in the *
'* spreadsheet to the next column. *
'**********************************************************************
Do Until EOF(1)
ReDim Preserve myArray(iCounter)
Line Input #1, myArray(iCounter)
LineDataIn = myArray(iCounter)
Do Until (StrComp(FieldText, chr$(32)&chr$(34)) = 0)
If (columnCounter >= 65) and (columnCounter <= 90) then
Column = Chr$(columnCounter)
ElseIf (columnCounter >= 91) and (columnCounter <= 116) then
Column = "A" & chr$(columnCounter - 26)
ElseIf (columnCounter >= 117) and (columnCounter <= 142) then
Column = "B" & chr$(columnCounter - 52)
ElseIf (columnCounter >= 143) and (columnCounter <= 168) then
Column = "C" & chr$(columnCounter - 78)
ElseIf (columnCounter >= 169) and (columnCounter <= 194) then
Column = "D" & chr$(columnCounter - 104)
ElseIf (columnCounter >= 195) and (columnCounter <= 220) then
Column = "E" & chr$(columnCounter - 130)
ElseIf (columnCounter >= 221) and (columnCounter <= 246) then
Column = "F" & chr$(columnCounter - 156)
ElseIf (columnCounter >= 247) and (columnCounter <= 272) then
Column = "G" & chr$(columnCounter - 192)
ElseIf (columnCounter >= 273) and (columnCounter <= 298) then
Column = "H" & chr$(columnCounter - 218)
Else
Column = "IA"
End If
FieldText = GetDelimitedField(jCounter, LineDataIn, Delimiter)
ReDim Preserve createdArray(jCounter)
createdArray(jCounter) = FieldText
ExcelApp.Range(Column & CStr(jCounter+1)).Select
ExcelApp.ActiveCell.FormulaR1C1 = createdArray(jCounter)
jCounter = jCounter + 1
Loop
iCounter = iCounter + 1
columnCounter = columnCounter + 1
'*************************
'* Re-Initialize values *
'*************************
FieldText = "initial Field Text"
jCounter = 0
Loop
'**********************************************************************
'* Save the Excel file, closes it, and closes the application. Then *
'* closes the input file *
'**********************************************************************
ExcelApp.ActiveWorkbook.Save
ExcelApp.ActiveWorkbook.Close
ExcelApp.Quit
Close #1
Set ExcelApp = Nothing
End Sub
No comments have been posted about This code takes a semicolon (;) delimited text file and transposes the rows and columns into an Exc. Why not be the first to post a comment about This code takes a semicolon (;) delimited text file and transposes the rows and columns into an Exc.