vba code only works in debug mode

rileyjm

Registered User.
Local time
Today, 05:16
Joined
Feb 14, 2011
Messages
18
I'm trying to insert a '0' into my table named [tbl_RIF-App Info]. The code works in debug mode just fine but when I run it outside of debug, the '0' does not get inserted. Even stranger, if I run a compact and repair and then run my code without debug mode, the '0' gets inserted?? I can't figure this one out.

Here is the code I'm running:

Option Compare Database
Dim DM As String
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strDocName As String
Dim blnQuitWord As Boolean
Dim RegDate As Date
Dim Application As String
Dim Applength As Byte
Dim FirstApp As String
Dim EstString As String
Dim Sponsor As String
Dim app As String
Dim strDBPath As String
Dim strPwd As String


Dim App1 As String
Dim iReply As Integer 'DM # Reply
Dim iCounter As Integer

Public Function GenerateRIF()
Call ResetWordProcess
Call Initialize_Apps
Call GetWordData(doc)
Call Get_Estimates(doc, app)
End Function

Public Function Initialize_Apps()

'Begin Assign Application Identifiers
App1 = "BDS-ST"

'End Assign Application Identifiers
End Function

Public Function GetWordData(doc)

strDocName = "H:\My Documents\RBIT\Working Files\" & _
InputBox("Enter the name of the Word RIF " & _
"you want to import:", "Import RIF")

Set appWord = CreateObject("Word.Application")
Set doc = appWord.Documents.Open(strDocName)
strDBPath = "Data Source=K:\Riley\Demand Mgmt Database 2_21_10.mdb;"
Call OpenProtectedDB(strDBPath, strPwd)

rst.Open "[tbl_Request Initiation Data]", cnn, _
adOpenKeyset, adLockOptimistic

With rst
.AddNew
![DM #] = InputBox("Enter DM# ", "DM")
DM = ![DM #]
' ![Registry Date] = InputBox("Enter Registery Date MM/DD/YYYY", "RegDate")
![RIF Created] = doc.FormFields("DateRecd").Result
![PMO Received] = Date
!Requester = doc.FormFields("Requester").Result
!Contact = doc.FormFields("Requester").Result
![Billing CC] = doc.FormFields("BillingCC").Result
![Business Justification] = doc.FormFields("BusJust").Result
![Ranking] = Null
If doc.FormFields("WR").Result <> Null Then
![SR #] = doc.FormFields("WR").Result
End If
![ECD #] = doc.FormFields("ECD").Result
![Requested Completion] = doc.FormFields("DateRequired").Result
![Short Description] = doc.FormFields("Title").Result
![Full Description] = doc.FormFields("LongDesc").Result
' Extract Application Name
If doc.FormFields("Dropdown7").Result <> "--" Then
If (doc.FormFields("Dropdown7").Result = "EDW") Then
![Primary App] = doc.FormFields("Dropdown7").Result
Application = "EDW"
EstString = Application & "=tbd"
Else
Applength = InStr(doc.FormFields("Dropdown7").Result, " ")
Application = Left(doc.FormFields("Dropdown7").Result, Applength - 1)
![Primary App] = Application
EstString = Application & "=tbd"
End If
ElseIf doc.FormFields("Dropdown8").Result <> "--" Then
Applength = InStr(doc.FormFields("Dropdown8").Result, " ")
Application = Left(doc.FormFields("Dropdown8").Result, Applength - 1)
![Primary App] = Application
EstString = Application & "=tbd"
End If
' Get list of cross impacted apps, separate by comma
If ![Primary App] = Null Then
![Primary App] = doc.FormFields("RBITApp1").Result
Else
If doc.FormFields("RBITApp1").Result <> "" Then
![Cross-Impacts] = doc.FormFields("RBITApp1").Result
EstString = doc.FormFields("RBITApp1").Result & "=tbd"
If doc.FormFields("RBITApp2").Result <> "" Then
![Cross-Impacts] = ![Cross-Impacts] & ", " & doc.FormFields("RBITApp2").Result
EstString = EstString & ", " & doc.FormFields("RBITApp2").Result & "=tbd"
If doc.FormFields("RBITApp3").Result <> "" Then
![Cross-Impacts] = ![Cross-Impacts] & ", " & doc.FormFields("RBITApp3").Result
EstString = EstString & ", " & doc.FormFields("RBITApp3").Result & "=tbd"
If doc.FormFields("RBITApp4").Result <> "" Then
![Cross-Impacts] = ![Cross-Impacts] & ", " & doc.FormFields("RBITApp4").Result
EstString = EstString & ", " & doc.FormFields("RBITApp4").Result & "=tbd"
If doc.FormFields("RBITApp5").Result <> "" Then
![Cross-Impacts] = ![Cross-Impacts] & ", " & doc.FormFields("RBITApp5").Result
EstString = EstString & ", " & doc.FormFields("RBITApp5").Result & "=tbd"
If doc.FormFields("RBITApp6").Result <> "" Then
![Cross-Impacts] = ![Cross-Impacts] & ", " & doc.FormFields("RBITApp6").Result
EstString = EstString & ", " & doc.FormFields("RBITApp6").Result & "=tbd"
End If
End If
End If
End If
End If
End If
End If
If doc.FormFields("OtherApp1").Result <> "" Then
![Cross-Impacts] = doc.FormFields("Otherapp1").Result
If doc.FormFields("OtherApp2").Result <> "" Then
![Cross-Impacts] = doc.FormFields("OtherApp2").Result
If doc.FormFields("OtherApp3").Result <> "" Then
![Cross-Impacts] = doc.FormFields("OtherApp3").Result
If doc.FormFields("OtherApp4").Result <> "" Then
![Cross-Impacts] = doc.FormFields("OtherApp4").Result
End If
End If
End If
End If
If doc.FormFields("LOB1").Result <> "--" Then
![LOB Authorizing] = doc.FormFields("LOB1").Result
ElseIf doc.FormFields("LOB2").Result <> "--" Then
![LOB Authorizing] = doc.FormFields("LOB2").Result
End If
If doc.FormFields("RetBU").Result <> "--" Then
![BU Authorizing] = doc.FormFields("RetBU").Result
ElseIf doc.FormFields("OtherLOB").Result <> "" Then
![BU Authorizing] = doc.FormFields("OtherLOB").Result
End If
'Extract Business Sponsor name w/o -BU
If doc.FormFields("Dropdown6").Result <> "list of authorized approvers" Then
Sponsor = doc.FormFields("Dropdown6").Result
![Business Sponsor] = Left(Sponsor, (InStr(Sponsor, "-") - 1))
Else: ![Business Sponsor] = doc.FormFields("Sponsor").Result
End If
!Status = ("Approved to Estimate - Queued for Registry")
![Sizing Estimate] = EstString
.Update
.Close
End With

' Set Estimates
'*********************************************************************************
rst.Open "[tbl_RIF-App Info]", cnn, adOpenKeyset, adLockOptimistic

With rst
FirstApp = "Yes"
rst.AddNew
![DM #] = DM
![Estimate_Type] = "Sizing"
rst.Update

rst.AddNew
![DM #] = DM
![Estimate_Type] = "Planning"
rst.Update

rst.AddNew
![DM #] = DM
![Estimate_Type] = "Commit"
rst.Update

rst.Close
End With

rst.Open "[tbl_BRDStatus]", cnn, adOpenKeyset, adLockOptimistic
With rst
rst.AddNew
![DM #] = DM
![Release#] = "AutoAdd"
rst.Update

End With
rst.Close

End Function
Public Function AppExists(doc As Variant, app As String) As Boolean
Dim i As Integer
For i = 1 To 6
If doc.FormFields("RBITApp" & i).Result = app Then
AppExists = True
Exit For
End If
Next
End Function
Public Function Get_Estimates(doc, app)
'rst.Open "[tbl_RIF-App Info]", cnn, adOpenKeyset, adLockOptimistic
rst.Open "[tbl_RIF-App Info]", cnn, adOpenKeyset
DoCmd.SetWarnings False
With rst
If Application = App1 Or AppExists(doc, App1) Then
'DoCmd.RunSQL "UPDATE [tbl_RIF-App Info] SET [" & App1 & "] = '0' WHERE [DM #] =" & DM
CurrentDb.Execute "UPDATE [tbl_RIF-App Info] SET [" & App1 & "] = '0' WHERE [DM #] =" & DM
End If

.Update
.Close

End With
doc.Close
If blnQuitWord Then appWord.Quit
cnn.Close
MsgBox "RIF Imported!"

End Function
 
App1 is just one of 90 different applications that I need to store estimates (hours) for. In the code I've pasted here, I've only included App1 instead of all 90. The code for each is the same. The problem is the DoCmd.RunSQL statement that inserts the '0'. I don't understand why it does exactly what I expect in debug mode but does not outside of debug unless I run a compact and repair first.
 
Ah ... A better question... Is it's data type String, Number, Date ...?
 
Tell you what I do not like is that you have a variable with the name Application. This is an Access Reserved word. Also using # characters in field names is bad naming conventions.

Also when stepping throught the code via breakpoints means that Access reads and processes the code 1 line at a time, when run normally Access reads all the code from top to bottom then goes to the start and begins the process. It may be that it can't keep pace with the code. It may be prudent to add a couple of DoEvents in your code to render the completion of a process before you move onto the next step.
 

Users who are viewing this thread

Back
Top Bottom