I have a code that adds the new record, and code that gets an attachment, but on clicking the add button, only the records are added and the attachment is not. Can someone help me?
Code:
Option Compare Database
Option Explicit
Private Sub Add_Click()
Dim yrID As Integer, mthid As Integer, measId As Integer, comLvlId As Integer, contId As Integer, stid As Integer
Dim prodId As Integer, lobId As Integer, busId As Integer, progId As Integer, comId As Integer, freqId As Integer
Dim memTgt As Variant, memRch As Variant, memConv As Variant, PROGENTDT As Variant, ts As Date
Dim rstQuality As DAO.Recordset
Dim rsChild As DAO.Recordset
Dim lngQualID As Long, st As String
Set rstQuality = CurrentDb.OpenRecordset("QualMain")
rstQuality.Index = "PrimaryKey"
If IsNull(prognm.Value) Or prognm.Value = "" Then
msgbox "Please select the program name."
prognm.SetFocus
Exit Sub
Else
progId = prognm.Column(1)
End If
If IsNull(stcd.Value) Or stcd.Value = "" Then
msgbox "Please select the state."
stcd.SetFocus
Exit Sub
Else
stid = stcd.Column(1)
End If
If IsNull(contact.Value) Or contact.Value = "" Then
msgbox "Please select the program owner name."
contact.SetFocus
Exit Sub
Else
contId = contact.Column(1)
End If
If IsNull(YR.Value) Or YR.Value = "" Then
msgbox "Please select the program year."
YR.SetFocus
Exit Sub
Else
If YR.Value = "2013" Then
yrID = 1
Else
yrID = YR.Value - 2013 + 1
End If
End If
If IsNull(MTH.Value) Or MTH.Value = "" Then
msgbox "Please select the program month."
MTH.SetFocus
Exit Sub
Else
mthid = MTH.Column(1)
End If
If IsNull(FREQ.Value) Or FREQ.Value = "" Then
msgbox "Please select the Frequency of Intervention."
FREQ.SetFocus
Exit Sub
Else
freqId = FREQ.Column(1)
End If
If IsNull(BUSUNIT.Value) Or BUSUNIT.Value = "" Then
msgbox "Please select the business unit."
BUSUNIT.SetFocus
Exit Sub
Else
busId = BUSUNIT.Column(1)
End If
If IsNull(LOB.Value) Or LOB.Value = "" Then
msgbox "Please select the line of business."
LOB.SetFocus
Exit Sub
Else
lobId = LOB.Column(1)
End If
If IsNull(prodnm.Value) Or prodnm.Value = "" Then
msgbox "Please select the plan/product."
prodnm.SetFocus
Exit Sub
Else
prodId = prodnm.Column(1)
End If
If IsNull(hedismeasure.Value) Or hedismeasure.Value = "" Then
msgbox "Please select the HEDIS Measure."
hedismeasure.SetFocus
Exit Sub
Else
measId = hedismeasure.Column(1)
End If
If IsNull(commlvl.Value) Or commlvl.Value = "" Then
msgbox "Please select customer, Provider or Member."
commlvl.SetFocus
Exit Sub
Else
comLvlId = commlvl.Column(1)
End If
If IsNull(COMMTYPE.Value) Or COMMTYPE.Value = "" Then
msgbox "Please select the communication type."
COMMTYPE.SetFocus
Exit Sub
Else
comId = COMMTYPE.Column(1)
End If
If Not IsNull(progdt.Value) Or progdt.Value <> "" Then
PROGENTDT = progdt.Value
Else
PROGENTDT = ""
End If
CurrentDb.Execute "INSERT INTO QualMain" & "(YR_ID,MTH_ID,MEASURES_ID,COMM_LVL_ID,CONTACT_ID,ST_ID,PROD_ID,LOB_ID,BUS_ID,PROG_ID,COMM_ID,FREQ_ID,PROG_ENTDT) Values" & "('" & yrID & "'" & "," & "'" & mthid & "'" & "," & "'" & measId & "'" & "," & "'" & comLvlId & "'" & "," & "'" & contId & "'" & "," & "'" & stid & "'" & "," & "'" & prodId & "'" & "," & "'" & lobId & "'" & "," & "'" & busId & "'" & "," & "'" & progId & "'" & "," & "'" & comId & "'" & "," & "'" & freqId & "'" & "," & "'" & PROGENTDT & "');"
If Not IsNull(txtPath.Value) Or txtPath.Value <> "" Then
st = txtPath.Value
lngQualID = DMax("[QID]", "[QualMain]")
rstQuality.Seek "=", lngQualID
rstQuality.Edit
Set rsChild = rstQuality.Fields("Attachment").Value
rsChild.AddNew
rsChild.Fields("FileData").LoadFromFile st
rsChild.Update
rstQuality.Update
End If
msgbox "Record successfully added."
End Sub
'THIS GETS THE ATTACHMENT FROM THE MACHINE AND PUTS IT IN THE LSTATTACH TEXTBOX
Private Sub cmdAdd_Click()
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
With dlgOpen
.AllowMultiSelect = False
.InitialFileName = "Z:\" 'Initial Path when explorer is opened
.Show
If .SelectedItems.Count = 0 Then
msgbox ("No file Selected") 'No file selected
Else
Me.lstAttach.AddItem .SelectedItems(1) 'sets textbox on the form to the path selected
End If
End With
End Sub