Append Data using VBA and Module

spectrolab

Registered User.
Local time
Today, 09:17
Joined
Feb 9, 2005
Messages
119
Hi Guys,

I have some VBA code (not mine as will become obvious) that takes data from a temporary table and writes it to a CSV or TXT file:

Code:
Private Sub cmdMakeALSCSV_Click()
Dim Accuracy As Single
    Dim AllowNeg As Boolean
    Dim Filename As String
    Dim i, J, TBLLoop, intRecs As Integer
    Dim sql, strColName As String
    Dim strResult As String
    Dim rst As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim DB As DAO.Database
    If IsNull([cboRepSelect]) Then
        MsgBox "Please select a jobnumber", vbExclamation, "No job number selected"
        DoCmd.GoToControl "cboRepSelect"
        Exit Sub
    End If
    
    Filename = "Y:\ALS CSV\" & Me.cboRepSelect & ".CSV"
    
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set A = fs.CreateTextFile(Filename, True)
       


    Set DB = CurrentDb
    Set rst = DB.OpenRecordset("tmpALSFormat")
    rst.MoveLast
    J = rst.recordcount
'Write header lines

    
     
    'Line 1
        
        'Write result type column headings
       
        A.Write ","
        Set rst2 = DB.OpenRecordset("LU_ColumnHeadingsALS", dbOpenDynaset)
        rst2.MoveLast
        intRecs = rst2.recordcount
        rst2.MoveFirst
        
             For TBLLoop = 1 To intRecs - 1
                strColName = rst2![ColumnName]
                A.Write strColName & ","
                rst2.MoveNext
             Next TBLLoop
                strColName = rst2![ColumnName]
                A.WriteLine strColName
 
    'End line 1
    
     'Line 2
        A.Write "Method," 'The word UNITS LEFT  Justified
        'Write detection limits
        rst2.MoveFirst

             For TBLLoop = 1 To intRecs - 1
                strColName = rst2![units]
                A.Write strColName & ","
                rst2.MoveNext

             Next TBLLoop
                strColName = rst2![units]
                A.WriteLine strColName
                
    'End line 2
    'Line3
    
        A.Write "Analyte," 'The word UNITS LEFT  Justified
        'Write method name
            rst2.MoveFirst

             For TBLLoop = 1 To intRecs - 1
                strColName = rst2![Method]
                A.Write strColName & ","
                rst2.MoveNext

             Next TBLLoop
                strColName = rst2![Method]
                A.WriteLine strColName
    
    
    'Write results
'******************************************************************************************

    rst.MoveFirst
    For i = 1 To J - 1
        
       
        A.Write rst.Fields(0) & ","
        rst2.MoveFirst
        For TBLLoop = 1 To intRecs - 1
           Accuracy = rst2!DETECTION
           AllowNeg = rst2!AllowNegs
           strResult = MakeResultALS(rst.Fields(TBLLoop), Accuracy, AllowNeg)
           A.Write strResult & ","
           rst2.MoveNext
        Next TBLLoop
           Accuracy = rst2!DETECTION
           AllowNeg = rst2!AllowNegs
           strResult = MakeResultALS(rst.Fields(intRecs), Accuracy, AllowNeg)
           A.WriteLine strResult & ","
           rst.MoveNext
   Next i
        A.Write rst.Fields(0) & ","
        rst2.MoveFirst
        For TBLLoop = 1 To intRecs - 1
           Accuracy = rst2!DETECTION
           AllowNeg = rst2!AllowNegs
           strResult = MakeResultALS(rst.Fields(TBLLoop), Accuracy, AllowNeg)
           A.Write strResult & ","
           rst2.MoveNext
        Next TBLLoop
           Accuracy = rst2!DETECTION
           AllowNeg = rst2!AllowNegs
           strResult = MakeResultALS(rst.Fields(intRecs), Accuracy, AllowNeg)
           A.WriteLine strResult & ","
   A.Close
    rst.Close
    rst2.Close
    Set DB = Nothing
    MsgBox Filename & " created"
    
End Sub

It writes numbers mainly to the file, based on the criteria outlined in the public function:

Code:
Public Function MakeResultALS(result As Variant, Accuracy As Single, AllowNegs As Boolean) As String
'Function used to display results
    If IsNull(result) Then
        MakeResultALS = "NSS"
        Exit Function
    End If
    If result < Accuracy / 2 And AllowNegs = False Then
         MakeResultALS = "0"
    Else
        Select Case Accuracy
            Case 0.1
                MakeResultALS = Format(result, "0.0")
            Case 0.01
                MakeResultALS = Format(result, "0.00")
            Case 0.001
                MakeResultALS = Format(result, "0.000")
            Case 0.0001
                MakeResultALS = Format(result, "0.0000")
            Case 0.00001
                MakeResultALS = Format(result, "0.00000")
        End Select
    End If

End Function

The criteria outlined in the function are specific to each temporary table and stored in another table, in this case LU_ColumnHeadingsALS.

What I am trying to do is write this temp table to another table in a linked DB using the criteria in the function, i.e if the result is less than detection, write this value to the new table.

Hope that makes sense, thanks in advance for any help you can provide.
 
why not take the easy road, if you dont know (enough) about this?? Just import the file into a new database?

But to write into a table you "simply" need to do something like:
Dim rsNew as dao.recordset
set rsNew = Currentdb.openrecordset("yourtable") ' Open the table
...
rsNew.addNew ' create record
rsNew!Field1 = SomeValue ' fill the data
rsNew!Field2 = SomeValue ' fill the data
...
rsNew.update ' update the record
...
rsNew.Close ' Done, close it
set rsNew = Nothing ' Clean up any memory beeing claimed.

Good luck !!
 
Thanks Mailman,

I can get that to work easily enough with an append query. I run into a problem when the data in the file is a negative number (our CV files can't have -ve values, hence the public function to prevent this). I tried the ABS function, but I would prefer the code to look at each value and then check if it less than the accuracy allowed and write the value if it is. If not, write something, say <Detection or 0.001.

Hope that makes sense.
 
Your format would make it 0.0 if it is below 0.1... why would this be a problem?
 

Users who are viewing this thread

Back
Top Bottom