Dear all,
This is part of the code for my Masters project which I wrote. I am using this code to run in VB to read data from approximately huge text files which contain raw data. Approximately 300 files each 6-7 MB; total 2.26GB text file data (each text file has like 30,000+ lines). The problem is using this code my data reads very slowly (30 days approximately to read all text files into excel worksheet), and I need to speed up the process. I was thinking if I convert to VB.NET 2005 it will execute faster.
Can anyone give me pointers on how to convert this into VB.NET, or if anyone of you can assist me, that would be a big help. I have no idea about VB.NET programming and am new, since I know most of the VB functions are obsolete in .NET 2005.
regards,
awyeah
This is part of the code for my Masters project which I wrote. I am using this code to run in VB to read data from approximately huge text files which contain raw data. Approximately 300 files each 6-7 MB; total 2.26GB text file data (each text file has like 30,000+ lines). The problem is using this code my data reads very slowly (30 days approximately to read all text files into excel worksheet), and I need to speed up the process. I was thinking if I convert to VB.NET 2005 it will execute faster.
Code:
Option Explicit
Dim rmr_files() As String Array containing directories and rmr data file names
Dim rmr_folder_name As String Name of first folder of RMR data
Dim rmr_file_list As String RMR data file names text file
Dim rmr_data_file As String RMR excel data file name
Dim sheet_names() As String Sheet names in excel RMR Data file
Dim sheet_index() As Long Index number of excel sheets
Dim found_sheet_index As Long Index number of found sheet
Public Sub ReadFirstRMRDataFileIntoExcel()
Dim filenum As Long
Dim filenum2 As Long
Dim str As String
Dim str2 As String
Dim sJoin As String
Dim row As Long
Dim remove_quotes As String
Dim customer_name As String
Dim line As Long
Dim line2 As Long
Dim count As Long
Dim fileno As Long
Dim filechange As Boolean
Dim customersheet As Boolean
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Excel.Worksheet
Set excel objects
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open(rmr_data_file)
xlApp.Visible = False
xlApp.DisplayAlerts = False
Change file indication
fileno = 1
filechange = False
Read only the files in the first folder of the RMR data
For count = LBound(rmr_files) To UBound(rmr_files)
If the rmr data folder is the first folder then proceed only
If InStr(rmr_files(count), rmr_folder_name) <> 0 Then
Open rmr data file and begin to read
filenum = FreeFile
Open "" & rmr_files(count) & "" For Input As filenum
row = 1
line = 1
Do While Not EOF(filenum)
Line Input #filenum, str
str = Trim(Pack(StripOut(str, """")))
Split string into separate words and characters
Dim i As Long
Dim sArray As Variant
sArray = Split(str, " ")
For i = LBound(sArray) To UBound(sArray)
sArray(i) = """" & sArray(i) & """"
Next
Join back array to convert into csv format
sJoin = Join(sArray, ",")
If UCase(Mid(sJoin, 2, 8)) = "RECORDER" Then
sJoin = Replace(sJoin, "RECORDER"",""ID", "RECORDER ID")
End If
New customer found
If InStr(sJoin, "RECORDER") <> 0 Then
row = 1
End If
Open new file
Get the name of the customer from second line after the "RECORDER" line
If row = 1 Then
filenum2 = FreeFile
Open "" & rmr_files(count) & "" For Input As filenum2
line2 = 1
Do While Not EOF(filenum2)
Line Input #filenum2, str2
str2 = Trim(Pack(StripOut(str2, """")))
If line2 = line + 1 Then
Split string into separate words and characters
Dim custArray As Variant
custArray = Split(str2, " ")
Get the name of customer
customer_name = custArray(0)
Exit Do
End If
line2 = line2 + 1
Loop
Close #filenum2
End If
Check if customer sheet already added or not in excel file
customersheet = False
For Each xlWs In xlWb.Worksheets
If Trim(customer_name) = Trim(xlWs.Name) Then
customersheet = True
Exit For
End If
Next
IF CUSTOMER DOES NOT EXIST IN EXCEL WORKBOOK THEN ONLY WRITE TO EXCEL SHEET
If customersheet = False Then
If it is the first customer in first file then
If line = 1 And xlWb.Worksheets(1).Name <> customer_name And fileno = 1 Then
xlWb.Worksheets(1).Name = customer_name
Set xlWs = xlWb.Sheets(1)
End If
If new customer create new worksheet and write to it
If row = 1 And line <> 1 And filechange = False Then
Add new sheet for customers in the same txt file
xlWb.Worksheets.Add
xlWb.Worksheets(1).Name = customer_name
Set xlWs = xlWb.Sheets(1)
ElseIf row = 1 And line = 1 And filechange = True Then
For new text files add new sheet for new customers
xlWb.Worksheets.Add
xlWb.Worksheets(1).Name = customer_name
Set xlWs = xlWb.Sheets(1)
File not going to change to the next until for loop increments
filechange = False
End If
End If
Write data into excel row
Dim col As Long
Dim tempArray As Variant
tempArray = Split(sJoin, ",")
For col = LBound(tempArray) To UBound(tempArray)
remove_quotes = Trim(Pack(Replace(tempArray(col), """", "")))
Splitting date into proper format
If col = 1 And row <> 1 Then
Dim dateleft As String
Dim datemid As String
Dim dateright As String
Splitting date into: dd/mm/yy
dateleft = Left(remove_quotes, 2)
datemid = Mid(remove_quotes, 3, 2)
dateright = Right(remove_quotes, 2)
Adjust dd/mm/yy to dd/mm/yyyy
If Left(dateright, 1) = 7 Or Left(dateright, 1) = 8 Or Left(dateright, 1) = 9 Then
dateright = "19" & dateright & ""
ElseIf Left(dateright, 1) = 0 Or Left(dateright, 1) = 1 Or Left(dateright, 1) = 2 Then
dateright = "20" & dateright & ""
End If
Set format: dd/mm/yyyy
xlWs.Cells(row, col + 1).Value = "" & dateleft & "/" & datemid & "/" & dateright & ""
Else
Add entry without splitting
xlWs.Cells(row, col + 1).Value = remove_quotes
End If
Next
Increment the row
row = row + 1
line = line + 1
DoEvents
Loop
Close #filenum
Save workbook before opening new data file
xlWb.SaveAs rmr_data_file
End If
Increase the file number read
fileno = fileno + 1
Check if file changed or not (new file or reading old file still)
filechange = True
DoEvents
Next
Save workbook and close excel
xlWb.SaveAs rmr_data_file
xlApp.Quit
Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
End SubCan anyone give me pointers on how to convert this into VB.NET, or if anyone of you can assist me, that would be a big help. I have no idea about VB.NET programming and am new, since I know most of the VB functions are obsolete in .NET 2005.
regards,
awyeah
