Private Sub Form_Timer() 'set timer to x milliseconds accordingly
Dim fs As New Scripting.FileSystemObject
Dim f As File
Dim fldr As Folder
'arnelgp
Dim lngTimer As Long, i As Long
Dim colFiles As New Collection
lngTimer = Me.TimerInterval
'kill the timer
Me.TimerInterval = 0
'end of arnelgp code
Set fldr = fs.GetFolder("C:\Results")
If fldr.Files.Count > 0 Then
For Each f In fldr.Files
'arnelgp
'put all files to collection object
'Name f As "C:\Results\SuperQ.txt"
colFiles.Add f
Next f
End If
Set f = Nothing
'This code made with MUCH help from Wayne Ryan at the Access World Forums.
'It opens a text file made by SuperQ software, containing individual analysis
'results and parses out the desired sample information to the table "new XRF Results"
'and the desired sample data to the table "XRF Results Concentration". The 2 tables
'are in a One-to-Many relationship, and the ResultID, an autonumber ID in "XRF Results",
'ties the related records together.
Dim dbs As DAO.Database 'Pull up database
Dim rst As DAO.Recordset 'Pull up individual recordset for table
Dim ResultID As Long 'The AutoNumber record ID
Dim SampleName As String 'The name of the actual sample analyzed
Dim ResultDate As String 'Date/Time value of the converted string for date of analysis
Dim Time As String
Dim FinalWeight As String
Dim MeasureOriginName As String 'Analytical program used to analyze sample in SuperQ
Dim Fe As Double
Dim Init As String
Dim LOI As String
Dim Fe2O3 As Double 'Result concentration, in %, from the analysis
Dim SiO2 As Double 'Result concentration, in %, from the analysis
Dim CaO As Double 'Result concentration, in %, from the analysis
Dim MnO As Double 'Result concentration, in %, from the analysis
Dim Al2O3 As Double 'Result concentration, in %, from the analysis
Dim TiO2 As Double 'Result concentration, in %, from the analysis
Dim MgO As Double 'Result concentration, in %, from the analysis
Dim P2O5 As Double 'Result concentration, in %, from the analysis
Dim SO3 As Double 'Result concentration, in %, from the analysis
Dim K2O As Double 'Result concentration, in %, from the analysis
Dim V2O5 As Double 'Result concentration, in %, from the analysis
Dim Cr2o3 As Double 'Result concentration, in %, from the analysis
Dim CoO As Double 'Result concentration, in %, from the analysis
Dim NiO As Double 'Result concentration, in %, from the analysis
Dim CuO As Double 'Result concentration, in %, from the analysis
Dim ZnO As Double 'Result concentration, in %, from the analysis
Dim As2O3 As Double 'Result concentration, in %, from the analysis
Dim PbO As Double 'Result concentration, in %, from the analysis
Dim BaO As Double 'Result concentration, in %, from the analysis
Dim Na2O As Double
Dim Cl As Double
Dim SnO As Double
Dim SQL As String 'The SQL statement used to pull data into the table "XRF Results Concentration"
Dim buffer As String
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblXRFResults") 'Set database table
'arnelgp
For i = 1 To colFiles.Count
'If fldr.Files.Count > 0 Then
DoCmd.SetWarnings False 'Turn off warning so that an Access message box does not appear
'for each record appended to the "tblXRFResultsConcentration" table
'arnelgp
'just makesure SuperQ.txt does not exists
If Len(Dir("C:\Results\SuperQ.txt")) > 0 Then Kill "C:\Results\SuperQ.txt"
'arnelgp
'rename it here
Name colFiles(i) As "C:\Results\SuperQ.txt"
Open "C:\Results\SuperQ.txt" For Input As #1 'Open the text file made by SuperQ to import the data
Line Input #1, buffer
While Not EOF(1)
Select Case Mid(buffer, 1, 2)
Case "Sa"
SampleName = RTrim(Mid(buffer, 24, 35))
Case "Ap"
MeasureOriginName = RTrim(Mid(buffer, 24, 20))
Case "Me"
ResultDate = RTrim(Mid(buffer, 24, 10))
Time = RTrim(Mid(buffer, 34, 11))
Case "In"
Init = RTrim(Mid(buffer, 24, 10))
Case "Fi"
FinalWeight = RTrim(Mid(buffer, 24, 10))
Case "LO"
LOI = RTrim(Mid(buffer, 24, 10))
Set rst = dbs.OpenRecordset("tblXRFResults")
rst.AddNew
rst!ID = SampleName
rst!SampleName = SampleName
rst!ResultDate = ResultDate
rst!Time = Time
rst!MeasureOriginName = MeasureOriginName
rst.Update
rst.Close
Set rst = dbs.OpenRecordset("tblXRFResults")
rst.MoveLast
ResultID = rst!ResultID
rst.Close
Case "Si"
SiO2 = RTrim(Mid(buffer, 17, 9))
Case "Fe"
Fe2O3 = RTrim(Mid(buffer, 17, 9))
Case "Ca"
CaO = RTrim(Mid(buffer, 17, 9))
Case "Mn"
MnO = RTrim(Mid(buffer, 17, 9))
Case "Al"
Al2O3 = RTrim(Mid(buffer, 17, 9))
Case "Ti"
TiO2 = RTrim(Mid(buffer, 17, 9))
Case "Mg"
MgO = RTrim(Mid(buffer, 17, 9))
Case "P2"
P2O5 = RTrim(Mid(buffer, 17, 9))
Case "SO"
SO3 = RTrim(Mid(buffer, 17, 9))
Case "K2"
K2O = RTrim(Mid(buffer, 17, 9))
Case "V2"
V2O5 = RTrim(Mid(buffer, 17, 9))
Case "Cr"
Cr2o3 = RTrim(Mid(buffer, 17, 9))
Case "Co"
CoO = RTrim(Mid(buffer, 17, 9))
Case "Ni"
NiO = RTrim(Mid(buffer, 17, 9))
Case "Cu"
CuO = RTrim(Mid(buffer, 17, 9))
Case "Zn"
ZnO = RTrim(Mid(buffer, 17, 9))
Case "As"
As2O3 = RTrim(Mid(buffer, 17, 9))
Case "Pb"
PbO = RTrim(Mid(buffer, 17, 9))
Case "Ba"
BaO = RTrim(Mid(buffer, 17, 9))
Case "Na"
Na2O = RTrim(Mid(buffer, 17, 9))
Case "Cl"
Cl = RTrim(Mid(buffer, 17, 9))
Case "Sn"
SnO = RTrim(Mid(buffer, 17, 9))
SQL = "INSERT INTO [tblXRFResultsConc] (ResultID, Fe2O3, SiO2, CaO, MnO, Al2O3, TiO2, MgO, P2O5, SO3, K2O, V2O5, Cr2O3, CoO, NiO, CuO, ZnO, As2O3, PbO, BaO, Na2O, Cl, SnO)" & _
"Values(" & ResultID & ", " & _
Fe2O3 & ", " & _
SiO2 & ", " & _
CaO & ", " & _
MnO & ", " & _
Al2O3 & ", " & _
TiO2 & ", " & _
MgO & ", " & _
P2O5 & ", " & _
SO3 & ", " & _
K2O & ", " & _
V2O5 & ", " & _
Cr2o3 & ", " & _
CoO & ", " & _
NiO & ", " & _
CuO & ", " & _
ZnO & ", " & _
As2O3 & ", " & _
PbO & ", " & _
BaO & ", " & _
Na2O & ", " & _
Cl & ", " & _
SnO & ");"
DoCmd.RunSQL SQL
End Select
Line Input #1, buffer
Wend
Close #1 'Close the text file.
'arnelgp
'this is redundant, there is already a fs object.
'
'Dim fso, f1, S
'
' Set fso = CreateObject("Scripting.FileSystemObject")
'
' Set f1 = fso.GetFile("C:\Results\SuperQ.txt")
'
' f1.Delete
'arnelgp
If Len(Dir("C:\Results\SuperQ.txt")) > 0 Then Kill "C:\Results\SuperQ.txt"
'End If
Next
Set fldr = Nothing
Set fs = Nothing
rst.Close
Set rst = Nothing
Set dbs = Nothing
'reinstate the timer
Me.TimerInterval = lngTimer
End Sub
