VBA Will run on one database but not another?

V

vapid2323

Scion
Local time
Today, 06:47
Joined
Jul 22, 2008
Messages
217
Ok I am not a VBA guy, I can understand a good amount of code but I need Google for the most part :p

I had this bit of code created for me to import a bunch of Excel documents into 5 tables inside access. The problem is that it works on a test database but not on my working database.

I guess what I am looking for is some direction on where I might look for issues.

Adding code, not sure if it will help :confused:
Code: 
Option Compare Database
Option Explicit
Public objExcel As Object 'Excel.Application
Public blnNewExcelLaunched As Boolean
Const blnOverWriteWithoutConfirmation As Boolean = True 'Change this to false, and the script will ask for confirmation before overwriting
Sub ProcessThisForm(strFile As String)
    Dim wbk As Object 'Excel.Workbook
    Dim wks As Object 'Excel.Worksheet
    Dim lngLastRow As Long
    Dim lngStartRow As Long
    Dim lngLoop As Long
    Dim rst As Recordset
    Dim lngFormIDForeignKey As Long
    Dim lngCategoryIDForeignKey As Long
    Dim strCurrentCategory As String
    Dim lngRowsDiscardedBelow As Long
 
    If objExcel Is Nothing Then
        On Error Resume Next
        Set objExcel = GetObject(, "Excel.Application")
        Err.Clear: On Error GoTo -1: On Error GoTo 0
        If objExcel Is Nothing Then
            Set objExcel = CreateObject("Excel.Application")
            blnNewExcelLaunched = True
        End If
    End If
    objExcel.Visible = 1
 
    Set wbk = objExcel.Workbooks.Open(strFile, 0, 1, , , , 1, , , 0, 0, , 0)
    For Each wks In wbk.Worksheets
        If wks.Visible = -1 Then 'xlSheetVisible
            Exit For
        End If
    Next wks
 
    On Error GoTo ErrHandler
 
    lngStartRow = wks.Range("$A:$A").Find(What:=1, LookAt:=xlWhole).Row
    lngLastRow = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
    Debug.Print wks.Cells(lngStartRow + 2, 3).Value
    Set rst = CurrentDb.OpenRecordset("SELECT [COI] FROM tblSMRForm WHERE [COI]=""" & wks.Cells(lngStartRow + 2, 3).Value & """", , [dbSeeChanges])
    If (rst.BOF And rst.EOF) Then 'Meaning the COI does not exist in the tblSMRForm
OverWRite:
        If InStr(1, wks.Range("$A:$A").Find(What:=6, LookIn:=xlValues, LookAt:=xlWhole).Offset(2, 1).Value, "Time out") = 0 Then
            'For Site name, if user has selected 'Other', then pick from the adjacent column
            CurrentDb.Execute ("INSERT INTO [tblSMRForm]" & vbNewLine & _
            "(COI, TypeOfVisit, SiteName, SiteCity, SiteState, VisitDate, TimeIn, TimeOut, MonitoredBy, PreparedBy, CompletionDate)" & vbNewLine & _
            "Values (""" & wks.Cells(lngStartRow + 2, 3).Value & """, " & vbNewLine & """" & _
            wks.Cells(lngStartRow, 3).Value & """, " & vbNewLine & """" & _
            IIf(wks.Cells(lngStartRow + 5, 3).Value = "Other", wks.Cells(lngStartRow + 5, 4).Value, wks.Cells(lngStartRow + 5, 3).Value) & """, " & vbNewLine & """" & _
            wks.Cells(lngStartRow + 6, 3).Value & """, " & vbNewLine & """" & _
            wks.Cells(lngStartRow + 7, 3).Value & """, " & vbNewLine & _
            CDate(wks.Cells(lngStartRow + 8, 3).Value) & ", " & vbNewLine & "#" & _
            CDate(wks.Cells(lngStartRow + 9, 3).Value) & "#, " & vbNewLine & "#" & _
            CDate(wks.Cells(lngLastRow, 3).Value) & "#, " & vbNewLine & """" & _
            wks.Cells(lngStartRow + 14, 3).Value & """, " & vbNewLine & """" & _
            wks.Cells(lngLastRow - 2, 3).Value & """, " & vbNewLine & "#" & _
            wks.Cells(lngLastRow - 1, 3).Value & "#)")
            lngRowsDiscardedBelow = 3
        Else
            CurrentDb.Execute ("INSERT INTO [tblSMRForm]" & vbNewLine & _
            "(COI, TypeOfVisit, SiteName, SiteCity, SiteState, VisitDate, TimeIn, TimeOut, MonitoredBy, PreparedBy, CompletionDate)" & vbNewLine & _
            "Values (""" & wks.Cells(lngStartRow + 2, 3).Value & """, " & vbNewLine & """" & _
            wks.Cells(lngStartRow, 3).Value & """, " & vbNewLine & """" & _
            IIf(wks.Cells(lngStartRow + 5, 3).Value = "Other", wks.Cells(lngStartRow + 5, 4).Value, wks.Cells(lngStartRow + 5, 3).Value) & """, " & vbNewLine & """" & _
            wks.Cells(lngStartRow + 6, 3).Value & """, " & vbNewLine & """" & _
            wks.Cells(lngStartRow + 7, 3).Value & """, " & vbNewLine & "#" & _
            CDate(wks.Cells(lngStartRow + 8, 3).Value) & "#, " & vbNewLine & "#" & _
            CDate(wks.Cells(lngStartRow + 9, 3).Value) & "#, " & vbNewLine & "#" & _
            CDate(wks.Cells(lngStartRow + 10, 3).Value) & "#, " & vbNewLine & """" & _
            wks.Cells(lngStartRow + 14, 3).Value & """, " & vbNewLine & """" & _
            wks.Cells(lngLastRow - 1, 3).Value & """, " & vbNewLine & "#" & _
            wks.Cells(lngLastRow, 3).Value & "#)")
            lngRowsDiscardedBelow = 2
        End If
        Set rst = Nothing
        Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT SMRFormID FROM tblSMRForm WHERE COI=""" & wks.Cells(lngStartRow + 2, 3).Value & """", , [dbSeeChanges])
        lngFormIDForeignKey = rst.Fields(0).Value
 
 
        For lngLoop = wks.Range("$A:$A").Find(What:=7, LookIn:=xlValues, LookAt:=xlWhole).Row To wks.Range("$A:$A").Find(What:=8, LookIn:=xlValues, LookAt:=xlWhole).Row - 1
            If InStr(1, wks.Cells(lngLoop, 3).Value, "N/A") = 0 Then
                CurrentDb.Execute "INSERT INTO [tblPersonnel] (Personnel, fk_SMRFormID) Values(""" & Replace(wks.Cells(lngLoop, 3).Value, """", """""") & """," & lngFormIDForeignKey & ")"
            End If
        Next lngLoop
 
        For lngLoop = 21 To lngLastRow - lngRowsDiscardedBelow
            If (IsNumeric(wks.Cells(lngLoop, 1).Value) Or (Not IsEmpty(wks.Cells(lngLoop, 2)))) And Not (wks.Cells(lngLoop, 1).Value & wks.Cells(lngLoop, 2).Value = "") Then
                Set rst = Nothing
                Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT CategoryID FROM [tblCategory] WHERE [Category]=""" & strCurrentCategory & """ AND [fk_SMRFormID]=" & lngFormIDForeignKey, , [dbSeeChanges])
                CurrentDb.Execute ("INSERT INTO [tblQandA] (Question, YesNoNAOption, Comments, fk_CategoryID, fk_SMRFormID) Values(""" & Replace(wks.Cells(lngLoop, 2).Value, """", """""") & """, """ & Replace(wks.Cells(lngLoop, 3).Value, """", """""") & """, """ & Replace(wks.Cells(lngLoop, 4).Value, """", """""") & """," & rst.Fields(0).Value & "," & lngFormIDForeignKey & ")")
            ElseIf (Not IsNumeric(wks.Cells(lngLoop, 1).Value)) And IsEmpty(wks.Cells(lngLoop, 2)) Then
                strCurrentCategory = wks.Cells(lngLoop, 1).Value
                CurrentDb.Execute ("INSERT INTO [tblCategory] (Category, fk_SMRFormID) Values(""" & Replace(strCurrentCategory, """", """""") & """," & lngFormIDForeignKey & ")")
            End If
        Next lngLoop
    Else
        Set rst = Nothing
        If blnOverWriteWithoutConfirmation Then
            GoTo GoToSilentOverWrite
        End If
        If vbOK = MsgBox("This COI already exists in the database!" & vbCrLf & vbCrLf & "To overwrite with data from this form, click OK", vbOKCancel + vbInformation, "Existing COI") Then
GoToSilentOverWrite:
            CurrentDb.Execute "DELETE * FROM [tblSMRForm] WHERE [COI]=""" & wks.Cells(lngStartRow + 2, 3).Value & """;"
            GoTo OverWRite
        End If
    End If
ErrHandler:
 
    If Err.Number <> 0 Then
        CurrentDb.Execute "INSERT INTO [tblErrorLog] SELECT """ & wbk.Name & """ AS WorkbookName,#" & Now() & "# AS ErrorDate,""" & Err.Description & """ AS ErrorDesc;"
        Err.Clear: On Error GoTo -1: On Error GoTo 0
    End If
    wbk.Close 0
    Set wks = Nothing
    Set wbk = Nothing
 
End Sub
 
The problem is that it works on a test database but not on my working database.
Click to expand...

Can you be a little more specific? How does it work or not work? What happens? Do you get an error message, or what? More details make it easier to help diagnose the problem.
 
boblarson said:
Can you be a little more specific? How does it work or not work? What happens? Do you get an error message, or what? More details make it easier to help diagnose the problem.
Click to expand...


Well the way the script should work is:
  1. Loop a bunch of Excel files get the data
  2. Import it into 4 tables (tblSMRForm, tblQandA, tblCategory and tblPersonnel)
  3. If there is an error with one of the files (like a date is wrong) then add a record to tblErrorLog for manual review.
On my test db everything works, you can see it loop though the files and the records are added to the tables properly

On the live database you can see excel open as it loops the excel files BUT no records are added to any table.

I might want to add, the only differance from the TestDB to the LiveDB is that I have other tables, macros reports and scripts in the live one. All I do is move the Modules over to the live db and try to run them.

The test DB uses the same SQL tables as the live DB.

No error messages, no issues with debug DB compiles and runs fine outlide of this.
 
Code: 
Set rst = CurrentDb.OpenRecordset("SELECT [COI] FROM tblSMRForm WHERE [COI]=""" & wks.Cells(lngStartRow + 2, 3).Value & """", , [dbSeeChanges])

I get a type mismatch on this line in the live database but not in the test database.... Not sure why :confused:
 
Change this line:
Dim rst As Recordset

to this
Dim rst As DAO.Recordset

and if you get the User Type not defined error then you have to make sure that the DAO reference is set when on the other computer (open its copy and go to the VBA window, TOOLS > REFERENCES and see if DAO 3.x (where .x is .51 or .6) is checked (if you are on 2007 or 2010 you should see
Microsoft Office Access Database Engine Object Library instead as that is the DAO reference for those (using the ACCDB file format - using the mdb format it would be the other).
 
You must log in or register to reply here.

Similar threads

Gasman
Solved Open Excel workbook, but have WorkBook_Open code run
Replies
19
Views
1,799
Gasman
Gasman
C
Solved Node level path
Replies
3
Views
501
ClaraBarton
C
C
Solved Position form to added record
Replies
8
Views
483
ClaraBarton
C
N
Solved How to remove this error "the execution this software stopped due to run time" error in MS Access VBA
Replies
11
Views
1,405
Minty
Minty
N
Solved How to send multiple attachment with CDO Gmail in MS Access VBA
Replies
11
Views
1,561
nector
N

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom