Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

My attachment code is not working correctly. I does not add the attachment.

Status
Not open for further replies.

mayhem11

Technical User
Jan 9, 2012
10
0
0
US
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
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top