HI Folks -
I'm having an issue with one of my VBA routines and I'm not sure why. I'm getting the following error:
Object variable or With block variable not set
And the issue is from this piece of code:
'strStep = "Update Data Element Attributes" & vbNewLine & vbNewLine & _
' "Data Element - " & Nz(tRS.Fields(strNameSub).Value, "") & vbNewLine & _
' "Source Field - " & Nz(sFld(i), "") & vbNewLine & _
' "Source Value - " & Nz(sRS.Fields(sFld(i)).Value, "") & vbNewLine & _
' "Target Field - " & Nz(tFld(i), "") & vbNewLine & _
' "Target Value - " & Nz(tRS.Fields(tFld(i)).Value, "")
But even when I declare it, I get same error. I'm declaring as :
Dim strStep As String
Below is the full function for your reference. Any ideas? Thanks!
Function Process_Indication_New()
On Error Resume Next
Dim dbs As DAO.Database
Dim sRS As DAO.Recordset
Dim tRS As DAO.Recordset
Dim tRSMV As DAO.Recordset
Dim SeqRS As DAO.Recordset
Dim fld As DAO.Field2
Dim sTable As String
Dim tTable As String
Dim strTempTable As String
Dim tgtStr, srcStr, tmpStr As String
Dim vStr() As String
Dim tFlds, sFlds, vCriteria As String
Dim tFld() As String
Dim sFld() As String
Dim actionVals As String
Dim actionVal() As String
Dim i, z, vSeq As Integer
Dim strMask As String
Dim strValue As Variant
Set ws = DBEngine.Workspaces(0)
Set dbs = ws.Databases(0)
On Error GoTo Proc_Err
strFunctName = "Process_Indication_New"
strMask = "IND": strInt = 9
sTable = "sysMdmParams"
tTable = "RD_Indications"
strNameSub = "Name"
tFlds = "Alias,IND_CODE,IND_DESC"
sFlds = "Alias,IND_CODE,IND_DESC"
actionVals = "ChangeProp,TREX-WorkingVersion,TA,,,,"
actionVal = Split(actionVals, ",")
tFld = Split(tFlds, ",")
sFld = Split(sFlds, ",")
Set tRS = dbs.OpenRecordset("Select * from [" & tTable & "] where [RequestStatus] = ""Approved""", dbOpenDynaset)
Set SeqRS = dbs.OpenRecordset("Select * from [" & sTable & "] where [Param] = ""seqIND""", dbOpenDynaset)
vSeq = SeqRS.Fields("ParamInt").Value
Call Clear_ActionScript_Table
If tRS.RecordCount > 0 And SeqRS.RecordCount > 0 Then
'start a transaction to ensure all updates are run or rolled back
ws.BeginTrans: strTFlag = 1
Do Until tRS.EOF
If Mid(Nz(tRS.Fields(strNameSub).Value), 1, 3) <> strMask Or Len(Nz(tRS.Fields(strNameSub).Value)) <> strInt Then
vSeq = vSeq + 1
tRS.Edit
tRS.Fields(strNameSub).Value = strMask & "-" + LPad(vSeq, 5, "0")
tRS.Update
tmpStr = ""
End If
Select Case tRS.Fields("RequestTA").Value
Case Is = "Neuroscience"
tmpStr = "TA-CNS"
Case Is = "Oncology"
tmpStr = "TA-ONCO"
Case Is = "Rare Diseases"
tmpStr = "TA-RARE-DISEASES"
Case Else
tmpStr = "TA-" + UCase(tRS.Fields("RequestTA").Value)
End Select
tRS.Edit
tRS.Fields("IND_CODE").Value = Mid(tRS.Fields(strNameSub).Value, 5, 5)
tRS.Fields("IND_DESC").Value = tRS.Fields("Alias").Value
tRS.Fields("TherapeuticArea").Value = tRS.Fields("RequestTA").Value
tRS.Update
actionVal(0) = "Add"
actionVal(3) = tRS.Fields(strNameSub).Value
actionVal(4) = tmpStr
actionVal(5) = "FALSE"
Call Add_ActionScript(actionVal)
actionVal(0) = "ChangeProp"
actionVal(3) = tRS.Fields(strNameSub).Value
For i = 0 To UBound(tFld)
'Set fld to check .IsComplex property
Set fld = tRS(tFld(i))
'strStep = "Update Data Element Attributes" & vbNewLine & vbNewLine & _
' "Data Element - " & Nz(tRS.Fields(strNameSub).Value, "") & vbNewLine & _
' "Source Field - " & Nz(sFld(i), "") & vbNewLine & _
' "Source Value - " & Nz(sRS.Fields(sFld(i)).Value, "") & vbNewLine & _
' "Target Field - " & Nz(tFld(i), "") & vbNewLine & _
' "Target Value - " & Nz(tRS.Fields(tFld(i)).Value, "")
'Ignore MVF Attributes
If Not fld.IsComplex Then
If Nz(tRS.Fields(tFld(i)).Value, "foo") <> "foo" Then
actionVal(4) = sFld(i)
actionVal(5) = Nz(tRS.Fields(tFld(i)).Value, "")
Call Add_ActionScript(actionVal)
End If
Else
'Set the multichoice record set
Set tRSMV = tRS(tFld(i)).Value
'set string variable with all the selected values seperated by commas
Do Until tRSMV.EOF
tRSMV.MoveFirst
Do Until tRSMV.EOF
tgtStr = tgtStr + tRSMV!Value.Value + ","
tRSMV.MoveNext
Loop
Loop
If Not tgtStr = "" Then
tgtStr = Mid(tgtStr, 1, Len(tgtStr) - 1)
actionVal(4) = sFld(i)
actionVal(5) = tgtStr
Call Add_ActionScript(actionVal)
tgtStr = ""
End If
End If
Next
If tRS.Fields("RequestStatus").Value <> "Published" Then
tRS.Edit
tRS.Fields("RequestStatus").Value = "Published"
tRS.Update
End If
tRS.MoveNext
Loop
SeqRS.Edit
SeqRS.Fields("ParamInt").Value = vSeq
SeqRS.Update
'commit all changes
ws.CommitTrans: strTFlag = 0
'Create Action Script
Call Export_ActionScript
Else
MsgBox "WARNING: No records to process"
End If
Set sRS = Nothing
Set tRS = Nothing
Set tRSMV = Nothing
Set SeqRS = Nothing
Proc_Exit:
Set ws = Nothing
Set dbs = Nothing
Exit Function
Proc_Err:
If Len(strStep) > 0 Then
EmailStep = strStep & vbNewLine & vbNewLine
Else
EmailStep = ""
End If
strSubject = "WARNING : Function '" & strFunctName & "' Failed"
strBody = strSubject & vbNewLine & vbNewLine & _
EmailStep & _
"Profile : " & CurrentUser() & vbNewLine & vbNewLine & _
"VB Module : " & Application.VBE.ActiveCodePane.CodeModule.name & vbNewLine & vbNewLine & _
"VB Error : " & Err.Description
strTo = "name@client.com"
Call MDM_Routines.Email_Utility(strSubject, strBody, strTo, "", "")
If strTFlag = 1 Then ws.Rollback
Resume Proc_Exit
End Function
