I have a question regarding a piece of coding I would like to make more efficient in Visual Basic. What I am trying to do is the following:
I have a folder containing 100 .csv files (comma delimited), these files have around 5000 lines and around 200 columns. The order of columns may vary from one file to another, and some column are missing in some files.
My goal is to create one big .csv file that combines all the 100 .csv files, with a selection of column that I specify in advance.
Here is how I proceed:
Create an array to store the name of the columns I want in the final “big .csv”
Loop through all the files in the folder. For each file,
For each line in the file, use the Split function, to create an array containing all the values for a given line.
create a mapping array, that store the position of the column in the file for each column name chosen in the first step (do this only for the first line of each file)
Write in a file (“the big .csv”) the header (do this only once)
Write in the same big file, for each line of each file, the data based on the position of the column.
So that process works well, I get the outcome that I want but it is very slow… (It takes ~40min on my computer for ~200 files which once appended contains 500,000 lines and 200 columns. A colleague has managed to do a similar process, appending all the files, using the data.table package in R, and he is able to perform the same appending with the same .csv tables in 5-10min on the same computer)
I was wondering if there is a better alternative than going through the file “cell by cell”? Could I identify the column I don’t want from the source file and delete them entirely? Is there a function to append files together rather than reading each cell and then write them back?
Edit: Alternatively, is there another programming language that is significantly more efficient (Python? Power-Shell?) to do this kind of files manipulation?
Edit2: More details about why I consider it slow.
Edit3: The piece of code relevant to my question as requested in the comments:
Public Module Public_Variables
'Initializr technical parameters
Public Enable_SQL_Upload As String = "Yes"
Public Enable_CSV_Output As String = "Yes"
Public Enable_Runlog As String = "Yes"
Public MPF_Type As String
'Initialize Path and Folder location
Public Path As String '= "L:\Prophet\1902_Analysis\results\RUN_200" ' "S:\Users\Jonathan\12_Project_Space\Input" '"K:\Prophet\1809\Model_B2_LS_Analysis\results\RUN_31"
'Initialize parameters for Actuarial SQL database connection
Public SQLServer As String '= "MELAIPWBAT01"
Public SQLDataBase As String '= "VALDATA"
Public SQLTableName As String '= "RPT_1902_" & Right(Path, 7) '"aMPF_Retail_1808"
Public HeaderScopeFileName As String
Public ValidFilesFileName As String = "S:\Users\Jonathan\12_Project_Space\Tables\ValidFiles.txt"
Public InputFileName As String = "S:\Users\Jonathan\12_Project_Space\Tables\Input.txt"
Public tsrl As String = Now.Year.ToString() + Now.Month.ToString() + Now.Day.ToString() + "_" + Now.Hour.ToString() + "h" + Now.Minute.ToString() + "m" + Now.Second.ToString() + "s"
Public RunLogFileName As String = "\\Melaipwbat01\c$\Users\AACT064\Desktop\SQL_CSV_BULK_INSERT\RunLog" & tsrl & ".csv"
Public RunLogFile As IO.StreamWriter = My.Computer.FileSystem.OpenTextFileWriter(RunLogFileName, False)
Public HeaderFile1 As String '= "K:\Prophet\1903\MPF\MPF_SNAPSHOT\C_TROC.rpt" ' "K:\Prophet\1903\Model_B2_LS_Analysis\results\RUN_200\C_TROC.rpt" '"K:\Prophet\1809\Model_B2_LS_Analysis\results\RUN_31\C_DIO0.rpt"
Public HeaderFile2 As String '= "K:\Prophet\1901\Model_GRP\results\RUN_16\CORS_0.rpt" '"K:\Prophet\1809\Model_B2_LS_Analysis\results\RUN_31\C_DIO0.rpt"
Public ValidFilesFile As New System.IO.StreamReader(ValidFilesFileName)
'UserForm Design
'Public UserFormHeight_Start As Integer = 800
'Public UserFormWidth_Start As Integer = 800
Public UserFormHeight_ProgressBarExtension As Integer = 0
Public UserFormWidth_ProgressBarExtension As Integer = 0
'Initialize Misc.
Public Input_Array(,) As String
Public TextLine As String
Public TextLineSplit() As String
Public ValidFilesArray(,) As String
Public RecordCount As Integer = 0
Public BodyString As String = ""
Public SqlCommandText1 As String = ""
Public SqlCommandText2 As String = ""
'Initialize IS variables
Public Is_RPT_Name As Integer = 1
Public Is_RPT_Type As Integer = 2
Public Is_RPT_Valid As Integer = 3
Public Is_Name As Integer = 1
Public Is_Type As String = 2
Public Is_Not_found As Integer = -1
Public Is_RetailDCS As Integer = 0
Public Is_GroupDCS As Integer = 1
Public Is_MPF_Type As Integer
Public Is_Input_Header As Integer = 1
Public Is_Input_Path As Integer = 2
Public Is_Input_Server As Integer = 3
Public Is_Input_Database As Integer = 4
Public Is_Input_TableName As Integer = 5
Public Is_Input_HeaderFileRetailDCS As Integer = 6
Public Is_Input_HeaderFileGroupDCS As Integer = 7
'Initialize temp variables
Public temp_Valid As Integer
'Initialize the header of the SQL table that is created from that application
Public HeaderScope(,) As String
Public HeaderMapId(,) As String
Public HeaderStringSQL As String = ""
Public HeaderStringCSV As String = ""
Public MappingFound As Boolean
'Initialization for the files looping
Public temp_file As Integer = 1
Public temp_line As Integer
Public temp_headerfile As String
Public FileSize As Integer
Public TimerCounter As Integer = 0
End Module
Public Class UF_UserForm
Private Sub UF_UserForm_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'Me.Height = UserFormHeight_Start
'Me.Width = UserFormWidth_Start
TB_Input.Text = InputFileName
CB_SQLUpload.Text = Enable_SQL_Upload
CB_CSVOutput.Text = Enable_CSV_Output
CB_Runlog.Text = Enable_Runlog
GB_Progress.Visible = False
End Sub
Private Sub B_Run_Click_1(sender As Object, e As EventArgs) Handles B_Run.Click
'Disable the button, switch to 'Progress' tab
B_Run.Enabled = False
TabControl1.SelectedIndex = 1
'Start the Timer
Timer1.Interval = 1000
TimerCounter = 0
Timer1.Start()
'Initilialize the parameters with the Text Box values
TB_Server.Enabled = False
TB_Database.Enabled = False
TB_TableName.Enabled = False
TB_Path.Enabled = False
TB_FileType.Enabled = False
CB_SQLUpload.Enabled = False
CB_CSVOutput.Enabled = False
CB_Runlog.Enabled = False
Enable_SQL_Upload = CB_SQLUpload.Text
Enable_CSV_Output = CB_CSVOutput.Text
Enable_Runlog = CB_Runlog.Text
'Extract the inputs from the input.txt file
Dim temp_Input As Integer
Dim InputFirstCol As String
Dim InputSecCol As String
Dim Nb_Of_Runs As Integer
Dim EndOfLoop As Boolean
InputFileName = TB_Input.Text
Dim InputFile As New System.IO.StreamReader(InputFileName)
temp_Input = 0
EndOfLoop = False
Do While InputFile.Peek() <> -1 And EndOfLoop = False
TextLine = InputFile.ReadLine()
TextLineSplit = TextLine.Split(",")
InputFirstCol = TextLineSplit(0)
If InputFirstCol <> "#" And InputFirstCol <> "" And InputFirstCol <> "--End--" Then
InputSecCol = TextLineSplit(1)
Else
InputSecCol = ""
End If
If InputFirstCol = "--End--" Then
EndOfLoop = True
Else
If InputFirstCol = "#" Then
temp_Input = temp_Input + 1
ElseIf InputFirstCol = "HeaderScope" Then
ReDim Preserve Input_Array(7, temp_Input)
Input_Array(Is_Input_Header, temp_Input) = InputSecCol
ElseIf InputFirstCol = "Path" Then
Input_Array(Is_Input_Path, temp_Input) = InputSecCol
ElseIf InputFirstCol = "Server" Then
Input_Array(Is_Input_Server, temp_Input) = InputSecCol
ElseIf InputFirstCol = "Database" Then
Input_Array(Is_Input_Database, temp_Input) = InputSecCol
ElseIf InputFirstCol = "TableName" Then
Input_Array(Is_Input_TableName, temp_Input) = InputSecCol
ElseIf InputFirstCol = "HeaderFileRetailDCS" Then
Input_Array(Is_Input_HeaderFileRetailDCS, temp_Input) = InputSecCol
ElseIf InputFirstCol = "HeaderFileGroupDCS" Then
Input_Array(Is_Input_HeaderFileGroupDCS, temp_Input) = InputSecCol
End If
End If
Loop
Nb_Of_Runs = temp_Input
'Create an array to store the timer per run
Dim Timer_Array(Nb_Of_Runs) As String
'Let's start the loop for each run
For temp_Run = 1 To Nb_Of_Runs
'Initialize date stamp variables and create the date stamp (called ts)
Dim now As DateTime = DateTime.Now
Dim ts As String = now.Year.ToString() + now.Month.ToString() + now.Day.ToString() + "_" + now.Hour.ToString() + "h" + now.Minute.ToString() + "m" + now.Second.ToString() + "s"
Dim temp_full_count As Integer = 0
Dim File_Count As Integer = 0
Dim temp_count As Integer = 0
'Open the.csv file
Dim OutputCSVFileName As String = "\\Melaipwbat01\c$\Users\AACT064\Desktop\SQL_CSV_BULK_INSERT\SQL_Upload" & ts & ".csv" ' "S:\Users\Jonathan\12_Project_Space\Output\RPT_Files" & ts & ".csv"
Dim SQLUploadFileName As String = Replace(OutputCSVFileName, "\\Melaipwbat01\c$", "C:")
Dim SQLQueriesFileName As String = "\\Melaipwbat01\c$\Users\AACT064\Desktop\SQL_CSV_BULK_INSERT\SQL_Queries" & ts & ".csv"
Dim outFile As IO.StreamWriter = My.Computer.FileSystem.OpenTextFileWriter(OutputCSVFileName, False)
Dim SQLQueriesFile As IO.StreamWriter = My.Computer.FileSystem.OpenTextFileWriter(SQLQueriesFileName, False)
'Store the inputs from the Input_Array
SQLServer = Input_Array(Is_Input_Server, temp_Run)
TB_Server.Text = Input_Array(Is_Input_Server, temp_Run)
SQLDataBase = Input_Array(Is_Input_Database, temp_Run)
TB_Database.Text = Input_Array(Is_Input_Database, temp_Run)
SQLTableName = Input_Array(Is_Input_TableName, temp_Run)
TB_TableName.Text = Input_Array(Is_Input_TableName, temp_Run)
Path = Input_Array(Is_Input_Path, temp_Run)
TB_Path.Text = Input_Array(Is_Input_Path, temp_Run)
HeaderScopeFileName = Input_Array(Is_Input_Header, temp_Run)
TB_FileType.Text = Input_Array(Is_Input_Header, temp_Run)
HeaderFile1 = Input_Array(Is_Input_HeaderFileRetailDCS, temp_Run)
TB_HeaderRetailDCS.Text = Input_Array(Is_Input_HeaderFileRetailDCS, temp_Run)
HeaderFile2 = Input_Array(Is_Input_HeaderFileGroupDCS, temp_Run)
TB_HeaderGroupDCS.Text = Input_Array(Is_Input_HeaderFileGroupDCS, temp_Run)
'Open the folder location and store all the files objetcs into files()
Dim files() As String = IO.Directory.GetFiles(Path)
'Open the Header scope .txt file
Dim HeaderScopeFile As New System.IO.StreamReader(HeaderScopeFileName)
'Initialize the variable ValidFilesArray
temp_Valid = 1
Do While ValidFilesFile.Peek() <> -1
TextLine = ValidFilesFile.ReadLine()
TextLineSplit = TextLine.Split(", ")
ReDim Preserve ValidFilesArray(3, temp_Valid)
ValidFilesArray(Is_RPT_Name, temp_Valid) = TextLineSplit(Is_RPT_Name - 1)
ValidFilesArray(Is_RPT_Type, temp_Valid) = TextLineSplit(Is_RPT_Type - 1)
ValidFilesArray(Is_RPT_Valid, temp_Valid) = TextLineSplit(Is_RPT_Valid - 1)
temp_Valid = temp_Valid + 1
Loop
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Display the Progress Group Box ''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
L_ProgressPC.Text = "Initialisation"
ProgressBar.Value = 0
GB_Progress.Visible = True
'Me.Height = UserFormHeight_Start + UserFormHeight_ProgressBarExtension
'Me.Width = UserFormWidth_Start + UserFormWidth_ProgressBarExtension
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Nb of Files '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' The goal of this piece of code aims at calculating the number of .rpt files
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
TB_Runlog.Text = "Checking number of .rpt files..." & Environment.NewLine & TB_Runlog.Text
For Each file As String In files
If CheckValidRPTFile(file, False) = True Then
File_Count = File_Count + 1
L_NbOfFiles.Text = File_Count
L_NbOfRuns.Text = temp_Run & "/" & Nb_Of_Runs
End If
Application.DoEvents()
Next
TB_Runlog.Text = "... " & " Run number " & temp_Run & Environment.NewLine & TB_Runlog.Text
TB_Runlog.Text = "... " & File_Count & " rpt files founds" & Environment.NewLine & TB_Runlog.Text
TB_Runlog.Text = "---------------------------------------" & Environment.NewLine & TB_Runlog.Text
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' The key is to define the header with the field names and the field types
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim HeaderNbOfField As Integer = 0
Do While HeaderScopeFile.Peek() <> -1
HeaderNbOfField = HeaderNbOfField + 1
'We split the libe into an array using the comma delimiter
TextLine = HeaderScopeFile.ReadLine()
TextLineSplit = TextLine.Split(", ")
ReDim Preserve HeaderScope(2, HeaderNbOfField)
HeaderScope(Is_Name, HeaderNbOfField) = TextLineSplit(0)
HeaderScope(Is_Type, HeaderNbOfField) = TextLineSplit(1)
Loop
'That array stores the position of a given field in the file
'It is important to initialise the array to -1
'When further down we assign HeaderMapId, if a value remains "-1" il will mean the field was not assigned thus not found.
'We will then assign a default value for those not found fields
ReDim HeaderMapId(1, HeaderNbOfField)
For temp_headermapini = 0 To HeaderNbOfField
HeaderMapId(Is_RetailDCS, temp_headermapini) = Is_Not_found
HeaderMapId(Is_GroupDCS, temp_headermapini) = Is_Not_found
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Header ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' The goal of this piece of code is to populate the variable HeaderMapId
' HeaderMapId stores the position of each field define is HeaderScope variable
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
L_ProgressPC.Text = "Find position of each field in the flat file"
'We use HeaderFile as the base to define the position of each field
'The application will function properly only if every .rpt file in the folder have same header as HeaderFile
For temp_header = 0 To 1
'We loop through 2 different type of MPFs
'Typicaly coming from Retail DCS and Group DCS
If temp_header = Is_RetailDCS Then
temp_headerfile = HeaderFile1
ElseIf temp_header = Is_GroupDCS Then
temp_headerfile = HeaderFile2
Else
temp_headerfile = "" 'Error
End If
Dim objReaderHeader As New System.IO.StreamReader(temp_headerfile)
'We read line by line until the end of the file
Do While objReaderHeader.Peek() <> -1
TextLine = objReaderHeader.ReadLine()
'We only care about the header, which starts with the character "!" in prophet .rpt files
If Strings.Left(TextLine, 1) = "!" Then
Dim temp_scope As Integer
Dim temp_scope_id As Integer
'We split the line in an array delimited by comma
TextLineSplit = TextLine.Split(", ")
'We loop through the array
'Once a field match one of the field define in HeaderScope, we store the position of that field in HeaderMapId
temp_scope_id = 1
For Each s As String In TextLineSplit
For temp_scope = 1 To UBound(HeaderScope, 2)
If HeaderScope(Is_Name, temp_scope) = s Then
HeaderMapId(temp_header, temp_scope) = temp_scope_id
End If
Next
temp_scope_id = temp_scope_id + 1
Next
End If
Loop
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Header''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Create the query for SQL table creation
Dim temp_field As Integer
For temp_field = 1 To HeaderNbOfField
If temp_field = 1 Then
HeaderStringSQL = "(Prophet_Name varchar(255),"
HeaderStringCSV = "Prophet_Name,"
End If
'We replace the bracket by underscore to avoid crashes when creating the SQL table
HeaderStringSQL = HeaderStringSQL & Replace(Replace(HeaderScope(Is_Name, temp_field), "(", "_"), ")", "_") & " " & HeaderScope(Is_Type, temp_field)
HeaderStringCSV = HeaderStringCSV & Replace(Replace(HeaderScope(Is_Name, temp_field), "(", "_"), ")", "_")
If temp_field <> HeaderNbOfField Then
HeaderStringSQL = HeaderStringSQL & ","
HeaderStringCSV = HeaderStringCSV & ","
Else
HeaderStringSQL = HeaderStringSQL & ")"
HeaderStringCSV = HeaderStringCSV & ","
End If
Next
If Enable_CSV_Output = "Yes" Then
'Remove braquets and single quotes
outFile.WriteLine(Replace(Replace(Replace(HeaderStringCSV, ")", ""), "(", ""), "'", ""))
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Body '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' We loop through all the files and pick the information we need based on HeaderMapId
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'We loop through each file in the folder location
For Each file As String In files
Dim objReader As New System.IO.StreamReader(file)
Dim fileInfo As New IO.FileInfo(file)
'We only loop through the valid .rpt files
If CheckValidRPTFile(file, True) = True Then
'Count the number of files we go through
temp_count = temp_count + 1
'Count the number of lines in the file (called FileSize)
'Dim objReaderLineCOunt As New System.IO.StreamReader(file)
'FileSize = 0
'Do While objReaderLineCOunt.Peek() <> -1
'TextLine = objReaderLineCOunt.ReadLine()
'FileSize = FileSize + 1
'Loop
FileSize = 1000000
'temp_line = 1
''We loop through line by line for a given file
'Do While objReader.Peek() <> -1
Dim TextLines() As String = System.IO.File.ReadAllLines(file)
For Each TextLine2 In TextLines
'Update the Progress Bar
temp_full_count = temp_full_count + 1
If temp_full_count Mod 200 = 0 Then
ProgressBar.Value = Int(100 * temp_count / File_Count)
L_ProgressPC.Text = "Processing file " & fileInfo.Name & " " & temp_count & "/" & File_Count & " - line " & temp_line & "/" & FileSize
L_RecordsProcessed.Text = temp_full_count
Application.DoEvents()
End If
'We split the libe into an array using the comma delimiter
'TextLine = objReader.ReadLine()
TextLineSplit = TextLine2.Split(", ")
'Skip line that are not actual prophet records (skip header and first few lines)
If Strings.Left(TextLine2, 1) = "*" Then
'We loop through the number of field we wish to extract for the file
For temp_field = 1 To HeaderNbOfField
If temp_field = 1 Then
BodyString = "('" & Strings.Left(fileInfo.Name, Len(fileInfo.Name) - 4) & "',"
End If
If MPF_Type = "RetailDCS" Then
Is_MPF_Type = Is_RetailDCS
ElseIf MPF_Type = "GroupDCS" Then
Is_MPF_Type = Is_GroupDCS
Else
MsgBox("Is_MPF_Type value is nor recognized")
End
End If
'The array HeaderMapId tells us where to pick the information from the file
'This assumes that each file in the folder have same header as the 'HeaderFile'
If HeaderMapId(Is_MPF_Type, temp_field) = Is_Not_found Then
BodyString = BodyString & "98766789"
Else
BodyString = BodyString & TextLineSplit(HeaderMapId(Is_MPF_Type, temp_field) - 1)
End If
If temp_field <> HeaderNbOfField Then
BodyString = BodyString & ","
Else
BodyString = BodyString & ")"
End If
Next
'We replace double quotes with single quotes
BodyString = Replace(BodyString, """", "'")
'This Line is to add records to the .csv file
If Enable_CSV_Output = "Yes" Then
'Remove braquets and single quotes
outFile.WriteLine(Replace(Replace(Replace(BodyString, ")", ""), "(", ""), "'", ""))
End If
End If
temp_line = temp_line + 1
Next
TB_Runlog.Text = "Completed: " & fileInfo.Name & Environment.NewLine & TB_Runlog.Text
temp_file = temp_file + 1
End If
Next
outFile.Close()
ProgressBar.Value = Int(100 * temp_count / File_Count)
L_RecordsProcessed.Text = temp_full_count
Application.DoEvents()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Upload to SQL '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' The goal of this code is to create the SQL table
' And push the .csv created into the SQL table using BULK INSERT function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
L_ProgressPC.Text = "Creating SQL Table"
Application.DoEvents()
If Enable_SQL_Upload = "Yes" Then
'First query is to create the table
SqlCommandText1 = "CREATE TABLE [" & SQLDataBase & "].[analysis]." & SQLTableName & "_" & ts & " " & HeaderStringSQL
'Second query is to populate the data
SqlCommandText2 = "BULK INSERT [" & SQLDataBase & "].[analysis]." & SQLTableName & "_" & ts & " " & " FROM '" & SQLUploadFileName & "' WITH ( FIELDTERMINATOR = ',', ROWTERMINATOR = '\n' , FIRSTROW=2)"
SQLQueriesFile.WriteLine(SqlCommandText1)
SQLQueriesFile.WriteLine(SqlCommandText2)
SQLQueriesFile.Close()
Using connection As New SqlConnection("Data Source=" & SQLServer & ";Integrated Security=True;Connection Timeout=2000;Initial Catalog=" & SQLDataBase & ";")
connection.Open()
Dim command As New SqlCommand(SqlCommandText1, connection)
command.ExecuteNonQuery()
Dim command2 = New SqlCommand(SqlCommandText2, connection)
command2.CommandTimeout = 2000
command2.ExecuteNonQuery()
connection.Close()
End Using
End If
Timer_Array(temp_Run) = L_Timer.Text
Next 'temp_Run
RunLogFile.Close()
Timer1.Stop()
L_ProgressPC.Text = "Job completed"
One way to speed up your program is to mininize the number of access to disk. Right now, you are reading each file twice, line-by-line. Each file most likely fits in memory. So, what you can do, is read all lines of a file in memory, and then process its lines. This will be much faster.
Something like:
'We only loop through the valid .rpt files
If CheckValidRPTFile(file, True) = True Then
''Count the number of files we go through
'temp_count = temp_count + 1
''Count the number of lines in the file (called FileSize)
'Dim objReaderLineCOunt As New System.IO.StreamReader(file)
'FileSize = 0
'Do While objReaderLineCOunt.Peek() <> -1
' TextLine = objReaderLineCOunt.ReadLine()
' FileSize = FileSize + 1
'Loop
'temp_line = 1
''We loop through line by line for a given file
'Do While objReader.Peek() <> -1
Dim TextLines() As String = System.IO.File.ReadAllLines(file)
For Each TextLine In TextLines
'We split into an array using the comma delimiter
'TextLine = objReader.ReadLine()
TextLineSplit = TextLine.Split(", ")
I looked at your updated code. You have a few additional performance issues in your code.
Reading and writing to network shared folder files is not very efficient especially when there is a lot of back and forth access to the file because everything goes through the network rather than direct local drive access.
Probably the most inefficient part of your program is iterating through your 200 fields for each line of the files. Let's say we have 5000 lines per file on average, then this means 200 x 5000 x 284 = 284 millions iterations!
The efficient method for accessing network shared files is to read an entire file in memory using System.IO.ReadAllLines() or System.IO.File.ReadAllText(), and then process its contents. Similarly, writing to a network shared file should consist of building the file contents in memory (if possible) using StringBuilder or a List(Of String), and then write the entire file to the network share with System.IO.File.WriteAllText() of System.IO.File.WriteAllLines. This should be the preferred way of accessing network shared files for best performance.
For the second performance issue, the loop through fields can be simplified as follows.
Dim BodyStringBuilder As New StringBuilder("")
BodyStringBuilder.Append("('" & Strings.Left(fileInfo.Name, Len(fileInfo.Name) - 4) & "',")
If MPF_Type = "RetailDCS" Then
Is_MPF_Type = Is_RetailDCS
ElseIf MPF_Type = "GroupDCS" Then
Is_MPF_Type = Is_GroupDCS
Else
MsgBox("Is_MPF_Type value is nor recognized")
End
End If
'Skip line that are not actual prophet records (skip header and first few lines)
If Strings.Left(TextLine2, 1) = "*" Then
'We loop through the number of field we wish to extract for the file
For temp_field = 1 To HeaderNbOfField
'The array HeaderMapId tells us where to pick the information from the file
'This assumes that each file in the folder have same header as the 'HeaderFile'
If HeaderMapId(Is_MPF_Type, temp_field) = Is_Not_found Then
BodyStringBuilder.Append("98766789,")
Else
BodyStringBuilder.Append(TextLineSplit(HeaderMapId(Is_MPF_Type, temp_field) - 1) & ",")
End If
Next
' Replace last "," by ")".
BodyStringBuilder.Remove(BodyStringBuilder.Length - 1, 1).Append(")")
'We replace double quotes with single quotes
BodyString = Replace(BodyString.ToString, """", "'")
Related
I found some Code to Copy a Folder with all its contents to another folder. the Folder name that is being copied to another folder is the same as the original folder in its original path. I want to add a timestamp with a date and time to show you the most recent 'copy' of the folder you copied.
An example would be:
Original Folder: Rage 2 ;
Copied Folder: Rage 2 - 3/11/2021 - 7:37
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim parts As String() = directoryTargetLocation.Split(New Char() {"\"c})
Dim filename As String = parts(parts.Count - 1) 'target folder name
Dim dir_path As String = "" 'directory without target folder name
For f As Integer = 0 To parts.Count - 2
dir_path += parts(f) + "\"
Next
Dim copied As Integer = 0
Dim counter As Integer = IO.Directory.GetFiles(directoryTargetLocation, "*.*", IO.SearchOption.AllDirectories).Length 'counts the number of files
SetProgressbar(counter, ProgressBar2) 'Sets ProgressBar maximum to number of files
setLabelTxt("Copied (0/" + counter.ToString + ")", Label4) 'displays the amount of copied files
Dim FolderList As New List(Of String)
FolderList.Add(directoryTargetLocation) 'Set first folder
Do While True
If (BackgroundWorker1.CancellationPending = True) Then 'cancel loop
e.Cancel = True
Exit Do
End If
Dim FoldersInsideDirectory As New List(Of String)
If FolderList.Count = 0 Then
Exit Do 'If there is no folder to copy Exit Do
Else
For l As Integer = 0 To FolderList.Count - 1
If (BackgroundWorker1.CancellationPending = True) Then 'stop for loop
e.Cancel = True
Exit For
End If
Dim sourceDirectoryInfo As New System.IO.DirectoryInfo(FolderList(l))
Dim dest As String = FolderList(l).Replace(dir_path, "")
If (Not System.IO.Directory.Exists(Destinydirectory + "\" + dest)) Then 'create subFolder inside directory
System.IO.Directory.CreateDirectory(Destinydirectory + "\" + dest)
End If
Dim fileSystemInfo As System.IO.FileSystemInfo
For Each fileSystemInfo In sourceDirectoryInfo.GetFileSystemInfos
If (BackgroundWorker1.CancellationPending = True) Then
e.Cancel = True
Exit For
End If
Dim destinationFileName As String = System.IO.Path.Combine(Destinydirectory + "\" + dest, fileSystemInfo.Name)
If TypeOf fileSystemInfo Is System.IO.FileInfo Then
Dim streamRead As New System.IO.FileStream(fileSystemInfo.FullName, System.IO.FileMode.Open)
setLabelTxt(fileSystemInfo.FullName.ToString, LabelProgress)
Dim streamWrite As New System.IO.FileStream(Destinydirectory + "\" + dest + "\" + fileSystemInfo.Name, IO.FileMode.Create, IO.FileAccess.Write, IO.FileShare.None)
Dim lngLen As Long = streamRead.Length - 1
setLabelTxt("Copy bytes : (0/" + (lngLen * 100).ToString + ")", Label10)
Dim byteBuffer(1048576) As Byte 'our stream buffer
Dim intBytesRead As Integer 'number of bytes read
While streamRead.Position < lngLen 'keep streaming until EOF
If (BackgroundWorker1.CancellationPending = True) Then
e.Cancel = True
Exit While
End If
BackgroundWorker1.ReportProgress(CInt(streamRead.Position / lngLen * 100))
setLabelTxt("Copy bytes : (" + CInt(streamRead.Position).ToString + "/" + (lngLen * 100).ToString + ")", Label10)
intBytesRead = (streamRead.Read(byteBuffer, 0, 1048576))
streamWrite.Write(byteBuffer, 0, intBytesRead)
End While
'Clean up
streamWrite.Flush()
streamWrite.Close()
streamRead.Close()
addProgress(1, ProgressBar2)
copied += 1
setLabelTxt("Copied (" + copied.ToString + "/" + counter.ToString + ")", Label4)
Else
FoldersInsideDirectory.Add(fileSystemInfo.FullName)
End If
Next
Next
FolderList.Clear()
FolderList = FoldersInsideDirectory
End If
Loop
End Sub
Before:
Dim streamWrite As New System.IO.FileStream(Destinydirectory + "\" + dest + "\" + fileSystemInfo.Name, IO.FileMode.Create, IO.FileAccess.Write, IO.FileShare.None)
After:
dim fnbase as string = Path.GetFileNameWithoutExtension(fileSystemInfo.Name)
dim fnexten as string = path.getextension(fileSystemInfo.Name)
dim fndate as string = DateTime.Now.ToString("yyyyMMdd HHmmss")
dim fn as string = $"{fnbase} - {fndate}{fnexten}"
Dim streamWrite As New System.IO.FileStream(Destinydirectory + "\" + dest + "\" + fn, IO.FileMode.Create, IO.FileAccess.Write, IO.FileShare.None)
I broke this down the way I did just so it was really easy for you to see the different pieces of it. You could just as easily put all of this together dynamically as the value you pass to System.IO.FileStream.
As an aside, you're doing the copy itself the complicated way. Maybe you need to use that method for a specific reason, but if not, maybe consider File.Copy next time.
I am fetching about 600 000 rows into a DataGridView (through SQL) and splitting them all into files by the date.
I tried several ways to do this, and while I found some ways to make it not crash and do it safely and securely, it's EXTREMELY slow.
The fastest way, however, I found to be simply cutting the date only out of the Date column, e.g. turning 2020/06/01 13:50:43 into 0601, and using that as the file name and then just append text to that file. (As opposed to either creating all the rows in a temp object and writing it all at once etc).
It's fast and everything is good, however after writing about, maybe 30? out of about 150 files, it crashes. It's very random, I tried running it a couple of times. It could crash after a few seconds or after half a minute. Hence, I believe it's caused by it tripping itself when trying to write so many times so fast.
I have tried changing the method to write several times, making sure to use Using blocks, as well as trying file share.
Here's my code:
Private Sub btnExec_Click(sender As Object, e As EventArgs) Handles btnExec.Click
Static start_time As DateTime
Static stop_time As DateTime
Dim elapsed_time As TimeSpan
start_time = Now
If IsNumeric(TextBox1.Text) Then columnNumber = CInt(TextBox1.Text) - 1
Dim dgw = Form1.DataGridView1
Dim curcell As String = ""
Dim ToWrite As String = ""
Dim Written As Integer = 0
Try
ProgressBar1.Maximum = dgw.Rows.Count
For i = 0 To dgw.Rows.Count - 1
'For each row
If IsDBNull(dgw.Rows(i).Cells(columnNumber).Value.ToString()) Then
curcell = "" 'if null replace with a blank value
Else
curcell = CStr(dgw.Rows(i).Cells(columnNumber).Value)
End If
'RB FORMATTING
If RadioButton1.Checked = True Then '2020/01/01 00:00:00
'2020/06/16 19:38:33
curcell = curcell.Remove(0, 5)
curcell = curcell.Remove(curcell.Length - 9, 9)
curcell = curcell.Replace("/", "")
'0616
End If
'Now we have 0616 in a string which is the date of the current row
Dim currow As String = ""
For Each c As DataGridViewCell In dgw.Rows(i).Cells
If IsDBNull(c.Value) Then
currow += Chr(34) + "" + Chr(34) + ","
Else
currow += Chr(34) + CStr(c.Value) + Chr(34) + ","
End If
Next
currow = currow.Remove(currow.Length - 1, 1) 'Remove last comma
'Now we have the full row to print as well as the date in a string
Dim FILENAME As String = TextBox2.Text + "\" + curcell + ".csv"
' Using fs As FileStream = File.OpenWrite(FILENAME)
' AddText(fs, currow + vbCrLf)
' End Using
Dim fs As FileStream = New FileStream(FILENAME, FileMode.OpenOrCreate, FileAccess.Write)
Dim w As StreamWriter = New StreamWriter(fs)
w.BaseStream.Seek(0, SeekOrigin.[End])
w.Write(currow + vbCrLf)
w.Close()
'Using writer As StreamWriter = File.AppendText(FILENAME)
'writer.WriteLine(currow)
' End Using
'My.Computer.FileSystem.WriteAllText(FILENAME, currow + vbCrLf, 1) 'Gets used by its own process error some times
Written += 1
Next 'Next row
stop_time = Now
elapsed_time = stop_time.Subtract(start_time)
Log("Wrote " + CStr(Written) + " lines in " + elapsed_time.TotalSeconds.ToString("0.00" & " seconds."))
Catch ex As Exception
Log(ex.ToString())
End Try
End Sub
Here's the error:
System.IO.IOException: The process cannot access the file 'C:\Users\username\Desktop\TEST2\0416.csv' because it is being used by another process.
at System.IO.__Error.WinIOError(Int32 errorCode, String maybeFullPath)
at System.IO.FileStream.Init(String path, FileMode mode, FileAccess access, Int32 rights, Boolean useRights, FileShare share, Int32 bufferSize, FileOptions options, SECURITY_ATTRIBUTES secAttrs, String msgPath, Boolean bFromProxy, Boolean useLongPath, Boolean checkHost)
at System.IO.FileStream..ctor(String path, FileMode mode, FileAccess access)
at TicketsSQL.frmSplitFiles.btnExec_Click(Object sender, EventArgs e) in C:\Users\username\source\repos\TicketsSQL\TicketsSQL\frmSplitFiles.vb:line 63
I commented out two other ways than the current one that I tried in the code. I tried the following three ways:
Dim fs As FileStream = New FileStream(FILENAME, FileMode.OpenOrCreate, FileAccess.Write)
Dim w As StreamWriter = New StreamWriter(fs)
w.BaseStream.Seek(0, SeekOrigin.[End])
w.Write(currow + vbCrLf)
w.Close()
Using writer As StreamWriter = File.AppendText(FILENAME)
writer.WriteLine(currow)
End Using
My.Computer.FileSystem.WriteAllText(FILENAME, currow + vbCrLf, 1)
It seems like no matter what way I try to prevent it using an already open file, or even allowing it to do so... it trips anyway.
Anyone have any work arounds or ways to solve this problem?
Try this and let us know what errors happen
Static start_time As DateTime
Static stop_time As DateTime
Dim elapsed_time As TimeSpan
start_time = Now
If IsNumeric(TextBox1.Text) Then columnNumber = CInt(TextBox1.Text) - 1
Dim dgw = Form1.DataGridView1
Dim curcell As String = ""
Dim ToWrite As String = ""
Dim Written As Integer = 0
Try
ProgressBar1.Maximum = dgw.Rows.Count
For i = 0 To dgw.Rows.Count - 1
'For each row
If IsDBNull(dgw.Rows(i).Cells(columnNumber).Value.ToString()) Then
curcell = "" 'if null replace with a blank value
Else
curcell = CStr(dgw.Rows(i).Cells(columnNumber).Value)
End If
'RB FORMATTING
If RadioButton1.Checked = True Then '2020/01/01 00:00:00
'2020/06/16 19:38:33
curcell = curcell.Remove(0, 5)
curcell = curcell.Remove(curcell.Length - 9, 9)
curcell = curcell.Replace("/", "")
'0616
End If
'Now we have 0616 in a string which is the date of the current row
Dim currow As String = ""
For Each c As DataGridViewCell In dgw.Rows(i).Cells
If IsDBNull(c.Value) Then
currow += Chr(34) + "" + Chr(34) + ","
Else
currow += Chr(34) + CStr(c.Value) + Chr(34) + ","
End If
Next
currow = currow.Remove(currow.Length - 1, 1) 'Remove last comma
'>>>>>>>>>>>>>>>>>>>>>>>>>
'Now we have the full row to print as well as the date in a string
Dim FILENAME As String
FILENAME = IO.Path.Combine(TextBox2.Text, curcell)
FILENAME = IO.Path.ChangeExtension(FILENAME, ".csv")
Try
IO.File.WriteAllText(FILENAME, currow & ControlChars.CrLf)
Catch ex As Exception
Stop ' what is the error <<<<<<<<<<<<<<<<<<<<<<
End Try
'<<<<<<<<<<<<<<<<<<<<<<<<<
Written += 1
Next 'Next row
stop_time = Now
elapsed_time = stop_time.Subtract(start_time)
Log("Wrote " + CStr(Written) + " lines in " + elapsed_time.TotalSeconds.ToString("0.00" & " seconds."))
Catch ex As Exception
Log(ex.ToString())
End Try
I use this function for copying some files from the Source folder to the Destination folder, but the copying is needed more time than usual.
Sub SyncFiles(Lbl_Percentage As Label, Lbl_FileName As Label, PrgrsBar As ProgressBar)
Try
Dim Sql As String = "SELECT GroupID FROM Tbl_Current"
Dim GetGroupID = MsAcc_RetriveTemp(Sql, 0)
Dim Sql1 As String = "Select * FROM Tbl_SyncPath where ID=" & GetGroupID
Dim Src As String = MsAcc_RetriveTemp(Sql1, 1)
Dim Des As String = MsAcc_RetriveTemp(Sql1, 2)
If Not IO.Directory.Exists(Des) Then IO.Directory.CreateDirectory(Des)
Dim fls() As String = IO.Directory.GetFiles(Des)
PrgrsBar.Value = 0
PrgrsBar.Maximum = fls.Count
For Each fn As String In fls
Dim filename As String = IO.Path.GetFileName(fn)
My.Computer.FileSystem.CopyDirectory(Des, Src, True)
PrgrsBar.Value += 1 'add 1 to the ProgressBar`s value
Dim Percntge As Integer = (PrgrsBar.Value / fls.Count) * 100
Lbl_Percentage.Text = Percntge & " %"
Lbl_FileName.Text = "جاري تحديث ملف: " & filename
Application.DoEvents()
Lbl_FileName.Text = "اكتمل عملية التحديث."
Next
Catch ex As Exception
End Try
End Sub
You copy all the files in the folder for each files.
For Each fn As String In fls
Dim filename As String = IO.Path.GetFileName(fn)
My.Computer.FileSystem.CopyDirectory(Des, Src, True) ' <--- No file specified
PrgrsBar.Value += 1 'add 1 to the ProgressBar`s value
Dim Percntge As Integer = (PrgrsBar.Value / fls.Count) * 100
Lbl_Percentage.Text = Percntge & " %"
Lbl_FileName.Text = "جاري تحديث ملف: " & filename
Application.DoEvents()
Lbl_FileName.Text = "اكتمل عملية التحديث."
Next
Put this outside the loop
My.Computer.FileSystem.CopyDirectory(Des, Src, True)
For Each fn As String In fls
' ...
Next
Also, seems like des and src are mixed up.
I am a novice at VB.NET and am working on an app the read the contents of a text file and use the paths therein for a file/folder copy. I am running the copy through a backgroundworker which does not seem to take the line string. To troubleshoot I have placed a MessageBox.Show(line) under the line reading logic to see if it is reading the path. It is not and jumps straight to my BackgroundWorker1_RunWorkerCompleted sub.
Can anyone see where I am going wrong?!
Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As ComponentModel.DoWorkEventArgs, Optional ByVal Overwrite As Boolean = True) Handles BackgroundWorker1.DoWork
Dim deststring As String
' Open config.txt with the Using statement.
Using r As StreamReader = New StreamReader(Application.StartupPath + "\CONFIG.txt")
Dim line As String
' Read first line.
line = r.ReadLine
' Loop over each line in file, While list is Not Nothing.
Do While (Not line Is Nothing)
' Read line and filter based on logic
If line.StartsWith("*") Then
r.ReadLine()
ElseIf line.Contains(Destpath) Then
r.ReadLine()
ElseIf line.Equals("%USERPROFILE%\Desktop") Then
line = desktoppath
ElseIf line.Equals("%USERPROFILE%\Downloads") Then
line = downloadsPath
ElseIf line.Equals("%USERPROFILE%\Contacts") Then
line = contactspath
ElseIf line.Equals("%USERPROFILE%\Documents") Then
line = documentspath
ElseIf line.Equals("%USERPROFILE%\Favorites") Then
line = favoritespath
ElseIf line.Equals("%USERPROFILE%\Links") Then
line = linkspath
ElseIf line.Equals("%USERPROFILE%\Music") Then
line = Musicpath
ElseIf line.Equals("%USERPROFILE%\Pictures") Then
line = picturespath
ElseIf line.Equals("%USERPROFILE%\SavedGames") Then
line = savedgamespath
ElseIf line.Equals("%USERPROFILE%\SavedSearches") Then
line = savedsearchespath
ElseIf line.Equals("%USERPROFILE%\Videos") Then
line = videospath
ElseIf line.Contains("%USERNAME%") Then
line = line.Replace("%USERNAME%", Username)
Else
Console.Writeline(line)
'Read line and create a full path for the destination
Dim SubPath As String = line.Split("\").Last
Dim FullDestPath As String = Destpath & "\" & SubPath
Console.Writeline(FullDestPath)
If Not System.IO.Directory.Exists(FullDestPath) Then
System.IO.Directory.CreateDirectory(FullDestPath)
End If
'Get directory info's
Dim SourceDir As DirectoryInfo = New DirectoryInfo(line)
Dim DestDir As DirectoryInfo = New DirectoryInfo(FullDestPath)
Dim ChildFile As FileInfo
'Loop through each file in the SourceDir
For Each ChildFile In SourceDir.GetFiles()
'Display file being copied
SetLabelText_ThreadSafe(Me.lblStatus, "Copying: " & line & "\" & ChildFile.Name & "")
'Do the copy
ChildFile.CopyTo(Path.Combine(DestDir.FullName, ChildFile.Name), True)
deststring = DestDir.ToString & "\" & ChildFile.Name
Dim sourcedirstring As String
sourcedirstring = SourceDir.ToString & "\" & ChildFile.Name
'Open Stream
Dim CopyStream As New FileStream(sourcedirstring, FileMode.Open, FileAccess.Read)
Dim NewStream As New FileStream(deststring, FileMode.CreateNew)
Dim Buffer(100000) As Byte
Dim BytesRead As Integer
'Try loop for each file
Try
Do
BytesRead = CopyStream.Read(Buffer, 0, Buffer.Length)
NewStream.Write(Buffer, 0, BytesRead)
PercentComplete = (NewStream.Length / CopyStream.Length * 100)
PercentComplete = Decimal.Round((PercentComplete), 2)
If PercentComplete > 100 Then
PercentComplete = "0"
End If
'if the file count is only 1 file then make both progress bars the same so that the current file and total are the same
If filecount = 1 Then
percentage = ((NewStream.Length + filetotalsofarcopied) / Overallsize.ToString * 100)
percentage = Decimal.Round((percentage), 2)
If percentage > 100 Then
percentage = 0
End If
SetLabelText_ThreadSafe(Me.lblTotalProgress, "" & percentage & "%")
Else
Timer6.Start()
percentage2 = ((NewStream.Length + filetotalsofarcopied) / Overallsize.ToString * 100)
percentage2 = Decimal.Round((percentage2), 2)
If percentage2 > 100 Then
percentage2 = 0
End If
SetLabelText_ThreadSafe(Me.lblTotalProgress, "" & percentage2 & "%")
End If
SetLabelText_ThreadSafe(Me.lblCurrentFileProgress, "" & PercentComplete & "%")
Dim time As Long = Label22.Text
'Calculate copy speed
Dim kbps As Double = (NewStream.Length + filetotalsofarcopied) / (time * 1024)
If kbps < 1024 Then
SetLabelText_ThreadSafe(Me.lblCopy, String.Format("Copy Speed: {0:0.00} KB/s", kbps))
Else
SetLabelText_ThreadSafe(Me.lblCopy, String.Format("Copy Speed: {0:0.00} MB/s", kbps / 1024))
End If
Loop Until BytesRead = 0 And PercentComplete = 100
Catch ex As Exception
Finally
CopyStream.Dispose()
NewStream.Dispose()
End Try
'File counter
int3 = int3 + 1
'Calculate data being moved for eta to completion
Dim filetotalbytes As Double = ChildFile.Length
filetotalsofarcopied = filetotalbytes + filetotalsofarcopied
'Check for pending cancel
If BackgroundWorker1.CancellationPending = True Then
BackgroundWorker1.CancelAsync()
Exit Sub
End If
Next
'Loop through Sub directories of SourceDir
Dim SubDir As DirectoryInfo
For Each SubDir In SourceDir.GetDirectories()
CopyDirectory(SubDir.FullName, Path.Combine(DestDir.FullName, SubDir.Name), Overwrite)
Next
End If
' Read in the next line.
line = r.ReadLine
Loop
End Using
End Sub
UPDATE: Included .text file contents:
***DESTINATION***
D:\Test
***Sources***
%USERPROFILE%\Downloads
%USERPROFILE%\Favorites
D:\User Data\Adam\Documents\Test
You should remove the calls to ReadLine inside the first two Ifs and replace them with the Continue Do keyword.
In general it is better to have just one call to ReadLine in your code.
For example you could check for End of Stream using the StreamReader.Peek method.
Finally the If block should be closed after the %USERNAME% check
' removed
' line = r.ReadLine()
Dim line As String
Do While r.Peek <> -1
line = r.ReadLine()
Console.Writeline(line)
If line.StartsWith("*") Then
' Not significant, skip to the next line
Continue Do
ElseIf line.Contains(Destpath) Then
' Not significant, skip to the next line
Continue Do
ElseIf line.Equals("%USERPROFILE%\Desktop") Then
line = desktoppath
ElseIf line.Equals("%USERPROFILE%\Downloads") Then
line = downloadsPath
ElseIf line.Equals("%USERPROFILE%\Contacts") Then
line = contactspath
ElseIf line.Equals("%USERPROFILE%\Documents") Then
line = documentspath
ElseIf line.Equals("%USERPROFILE%\Favorites") Then
line = favoritespath
ElseIf line.Equals("%USERPROFILE%\Links") Then
line = linkspath
ElseIf line.Equals("%USERPROFILE%\Music") Then
line = Musicpath
ElseIf line.Equals("%USERPROFILE%\Pictures") Then
line = picturespath
ElseIf line.Equals("%USERPROFILE%\SavedGames") Then
line = savedgamespath
ElseIf line.Equals("%USERPROFILE%\SavedSearches") Then
line = savedsearchespath
ElseIf line.Equals("%USERPROFILE%\Videos") Then
line = videospath
ElseIf line.Contains("%USERNAME%") Then
line = line.Replace("%USERNAME%", Username)
End If
' Now your line variable should be always correct and
' you can execute your copying logic
......
line = r.ReadLine
Loop
There is this database program that I am working on. For some reason the boss purchased all 64bit 2010 Office Suites so I am updating the program to work on the 64bit Office.
In this section I have a problem with trying to figure out the way to make this work on 64bit Access. I can't seem to get a straight answer about msaof, nor can I find any work that has the updated code. Its part of the Northwind Refresh Table Link which can be found on the internet but code only works in 32bit.
Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
' This sub converts from the friendly MSAccess structure to the win32 structure.
Dim strFile As String * 512
' Initialize some parts of the structure.
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplateName = 0
of.lCustrData = 0
If msaof.strFilter = "" Then
of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
Else
of.lpstrFilter = msaof.strFilter
End If
of.nFilterIndex = msaof.lngFilterIndex
of.lpstrFile = msaof.strInitialFile & String$(512 - Len(msaof.strInitialFile), 0)
of.nMaxFile = 511
of.lpstrFileTitle = String$(512, 0)
of.nMaxFileTitle = 511
of.lpstrTitle = msaof.strDialogTitle
of.lpstrInitialDir = msaof.strInitialDir
of.lpstrDefExt = msaof.strDefaultExtension
of.flags = msaof.lngFlags
of.lStructSize = Len(of)
End Sub
One of thing is that I get the error "of.nMaxCustrFilter = 0" does not exist but when I comment it out the debugger still points to it and Highlights the entire first line.
Update:This is the entire code
Option Explicit ' Require variables to be declared before being used.
Option Compare Database ' Use database order for string comparisons.
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Type MSA_OPENFILENAME
' Filter string used for the File Open dialog filters.
' Use MSA_CreateFilterString() to create this.
' Default = All Files, *.*
strFilter As String
' Initial Filter to display.
' Default = 1.
lngFilterIndex As Long
' Initial directory for the dialog to open in.
' Default = Current working directory.
strInitialDir As String
' Initial file name to populate the dialog with.
' Default = "".
strInitialFile As String
strDialogTitle As String
' Default extension to append to file if user didn't specify one.
' Default = System Values (Open File, Save File).
strDefaultExtension As String
' Flags (see constant list) to be used.
' Default = no flags.
lngFlags As Long
' Full path of file picked. On OpenFile, if the user picks a
' nonexistent file, only the text in the "File Name" box is returned.
strFullPathReturned As String
' File name of file picked.
strFileNameReturned As String
' Offset in full path (strFullPathReturned) where the file name
' (strFileNameReturned) begins.
intFileOffset As Integer
' Offset in full path (strFullPathReturned) where the file extension begins.
intFileExtension As Integer
End Type
Const ALLFILES = "All Files"
Type OPENFILENAME
lStructSize As Long
hwndOwner As LongPtr
hInstance As LongPtr
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As LongPtr
lpTemplateName As String
End Type
Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10
Function FindNorthwind(strSearchPath) As String
' Displays the open file dialog box for the user to locate
' the ElectricData database. Returns the full path to ElectricData.
Dim msaof As MSA_OPENFILENAME
' Set options for the dialog box.
msaof.strDialogTitle = "Where Is ElectricData.accdb?"
msaof.strInitialDir = strSearchPath
msaof.strFilter = MSA_CreateFilterString("Databases", "**.accdb")
' Call the Open File dialog routine.
MSA_GetOpenFileName msaof
' Return the path and file name.
FindNorthwind = Trim(msaof.strFullPathReturned)
End Function
Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
' Creates a filter string from the passed in arguments.
' Returns "" if no args are passed in.
' Expects an even number of args (filter name, extension), but
' if an odd number is passed in, it appends *.*
Dim strFilter As String
Dim intRet As Integer
Dim intNum As Integer
intNum = UBound(varFilt)
If (intNum <> -1) Then
For intRet = 0 To intNum
strFilter = strFilter & varFilt(intRet) & vbNullChar
Next
If intNum Mod 2 = 0 Then
strFilter = strFilter & "*.*" & vbNullChar
End If
strFilter = strFilter & vbNullChar
Else
strFilter = ""
End If
MSA_CreateFilterString = strFilter
End Function
Function MSA_ConvertFilterString(strFilterIn As String) As String
' Creates a filter string from a bar ("|") separated string.
' The string should pairs of filter|extension strings, i.e. "Access Databases|**.accdb|All Files|*.*"
' If no extensions exists for the last filter pair, *.* is added.
' This code will ignore any empty strings, i.e. "||" pairs.
' Returns "" if the strings passed in is empty.
Dim strFilter As String
Dim intNum As Integer, intPos As Integer, intLastPos As Integer
strFilter = ""
intNum = 0
intPos = 1
intLastPos = 1
' Add strings as long as we find bars.
' Ignore any empty strings (not allowed).
Do
intPos = InStr(intLastPos, strFilterIn, "|")
If (intPos > intLastPos) Then
strFilter = strFilter & Mid$(strFilterIn, intLastPos, intPos - intLastPos) & vbNullChar
intNum = intNum + 1
intLastPos = intPos + 1
ElseIf (intPos = intLastPos) Then
intLastPos = intPos + 1
End If
Loop Until (intPos = 0)
' Get last string if it exists (assuming strFilterIn was not bar terminated).
intPos = Len(strFilterIn)
If (intPos >= intLastPos) Then
strFilter = strFilter & Mid$(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
intNum = intNum + 1
End If
' Add *.* if there's no extension for the last string.
If intNum Mod 2 = 1 Then
strFilter = strFilter & "*.*" & vbNullChar
End If
' Add terminating NULL if we have any filter.
If strFilter <> "" Then
strFilter = strFilter & vbNullChar
End If
MSA_ConvertFilterString = strFilter
End Function
Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
' Opens the file save dialog.
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_to_OF msaof, of
of.flags = of.flags Or OFN_HIDEREADONLY
intRet = GetSaveFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetSaveFileName = intRet
End Function
Function MSA_SimpleGetSaveFileName() As String
' Opens the file save dialog with default values.
Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String
intRet = MSA_GetSaveFileName(msaof)
If intRet Then
strRet = msaof.strFullPathReturned
End If
MSA_SimpleGetSaveFileName = strRet
End Function
Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer
' Opens the file open dialog.
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_to_OF msaof, of
intRet = GetOpenFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetOpenFileName = intRet
End Function
Function MSA_SimpleGetOpenFileName() As String
' Opens the file open dialog with default values.
Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String
intRet = MSA_GetOpenFileName(msaof)
If intRet Then
strRet = msaof.strFullPathReturned
End If
MSA_SimpleGetOpenFileName = strRet
End Function
Public Function CheckLinks() As Boolean
' Check links to the ElectricData database; returns true if links are OK.
Dim dbs As Database, rst As DAO.Recordset
Set dbs = CurrentDb()
' Open linked table to see if connection information is correct.
On Error Resume Next
Set rst = dbs.OpenRecordset("lstPartClasses")
' If there's no error, return True.
If Err = 0 Then
CheckLinks = True
Else
CheckLinks = False
End If
End Function
Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
' This sub converts from the win32 structure to the friendly MSAccess structure.
msaof.strFullPathReturned = Left$(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
msaof.strFileNameReturned = of.lpstrFileTitle
msaof.intFileOffset = of.nFileOffset
msaof.intFileExtension = of.nFileExtension
End Sub
Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
' This sub converts from the friendly MSAccess structure to the win32 structure.
Dim strFile As String * 512
' Initialize some parts of the structure.
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplateName = 0
of.lCustrData = 0
If msaof.strFilter = "" Then
of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
Else
of.lpstrFilter = msaof.strFilter
End If
of.nFilterIndex = msaof.lngFilterIndex
of.lpstrFile = msaof.strInitialFile & String$(512 - Len(msaof.strInitialFile), 0)
of.nMaxFile = 511
of.lpstrFileTitle = String$(512, 0)
of.nMaxFileTitle = 511
of.lpstrTitle = msaof.strDialogTitle
of.lpstrInitialDir = msaof.strInitialDir
of.lpstrDefExt = msaof.strDefaultExtension
of.flags = msaof.lngFlags
of.lStructSize = Len(of)
End Sub
Private Function RefreshLinks(strFilename As String) As Boolean
' Refresh links to the supplied database. Return True if successful.
Dim dbs As Database
Dim intCount As Integer
Dim tdf As TableDef
' Loop through all tables in the database.
Set dbs = CurrentDb
For intCount = 0 To dbs.TableDefs.Count - 1
Set tdf = dbs.TableDefs(intCount)
' If the table has a connect string, it's a linked table.
If Len(tdf.Connect) > 0 Then
tdf.Connect = ";DATABASE=" & strFilename
' Debug.Print tdf.Connect
' Debug.Print tdf.SourceTableName
Err = 0
On Error Resume Next
tdf.RefreshLink ' Relink the table.
If Err <> 0 Then
RefreshLinks = False
Exit Function
End If
End If
Next intCount
RefreshLinks = True ' Relinking complete.
End Function
Public Function RelinkTables() As Boolean
' Tries to refresh the links to the American Campus IT Department database.
' Returns True if successful.
Const conMaxTables = 8
Const conNonExistentTable = 3011
Const conNotNorthwind = 3078
Const conNwindNotFound = 3024
Const conAccessDenied = 3051
Const conReadOnlyDatabase = 3027
Const conAppTitle = "Calvin's Electric - Bid/Job Program"
Dim strAccDir As String
Dim strSearchPath As String
Dim strFilename As String
Dim intError As Integer
Dim strError As String
' Get name of directory where Msaccess.exe is located.
strAccDir = SysCmd(acSysCmdAccessDir)
' Get the default sample database path.
If Dir(strAccDir & "\.") = "" Then
strSearchPath = strAccDir
Else
strSearchPath = strAccDir & "\"
End If
' Look for the ElectricData database.
If (Dir(strSearchPath & "ElectricData.accdb") <> "") Then
strFilename = strSearchPath & "ElectricData.accdb"
Else
' Can't find ElectricData, so display the File Open dialog.
MsgBox "Can't find linked tables in the Calvin's Electric Bid And Job Program. You must locate the ElectricData Database in order to use " _
& conAppTitle & ".", vbExclamation
strFilename = FindNorthwind(strSearchPath)
If strFilename = "" Then
strError = "Sorry, you must locate ElectricData.accdb to open " & conAppTitle & "."
GoTo Exit_Failed
End If
End If
' Fix the links.
If RefreshLinks(strFilename) Then ' It worked!
RelinkTables = True
Exit Function
End If
' If it failed, display an error.
Select Case Err
Case conNonExistentTable, conNotNorthwind
strError = "File '" & strFilename & "' does not contain the required ElectricData tables."
Case Err = conNwindNotFound
strError = "You can't run " & conAppTitle & " until you locate the ElectricData database."
Case Err = conAccessDenied
strError = "Couldn't open " & strFilename & " because it is read-only or located on a read-only share."
Case Err = conReadOnlyDatabase
strError = "Can't reattach tables because " & conAppTitle & " is read-only or is located on a read-only share."
Case Else
strError = Err.Description
End Select
Exit_Failed:
MsgBox strError, vbCritical
RelinkTables = False
End Function
As an alternative to messing around with the 32/64-bit API declarations, you could just use the Application.FileDialog method that is available in Access 2010. It works with both the 32-bit and 64-bit versions of Access.
It seems likely that you have Declare Function somewhere that need to read Declare PtrSafe Function. Then you will have to make sure that you have a 64 bit library for the DLL you are calling. It seems (not well tested) to work fine in my 64 bit application using the code here http://www.dbforums.com/microsoft-access/990945-building-database-help.html.