I have the following code, which should loop through all the forms in the project, and give a messagebox with the settings for each form. I know the loop is correct, because I use the loop elsewhere and I just copied it. Why is the messagebox blank?
For Each frm In CurrentProject.AllForms
DoCmd.OpenForm frm.Name, acDesign
mess = "Form: " & frm.Name & vbCrLf & " Allow Addition: " & CStr(frm.AllowAdditions) & vbCrLf & "Allow Deletions: " & CStr(frm.AllowDeletions) & vbCrLf & " Allow Edit: " & CStr(frm.AllowEdits)
MsgBox (mess)
DoCmd.Close acForm, frm.Name, acSaveYes
Next frm
Set frm = Nothing
With Remou's tips, I got the following to work:
For Each frm In CurrentProject.AllForms
DoCmd.OpenForm frm.Name, acDesign
Set frm = Forms(frm.Name)
mess = "Form: " & frm.Name & vbCrLf & " Allow Addition: " & CStr(frm.AllowAdditions) & vbCrLf & "Allow Deletions: " & CStr(frm.AllowDeletions) & vbCrLf & " Allow Edit: " & CStr(frm.AllowEdits)
MsgBox (mess)
DoCmd.Close acForm, frm.Name, acSaveNo
Next frm
Set frm = Nothing
You cannot access form properties without opening the form. You should only use Set with objects, not with strings.
See Access 2010: Which form control fires a macro?
For Each f In CurrentProject.AllForms
DoCmd.OpenForm f.Name, acDesign
Set frm = Forms(f.Name)
mess = "Form: " & frm.Name & vbCrLf
mess = mess & " Allow Addition: " & CStr(frm.AllowAdditions) & vbCrLf
mess = mess & "Allow Deletions: " & CStr(frm.AllowDeletions) & vbCrLf
mess = mess & " Allow Edit: " & CStr(frm.AllowEdits)
MsgBox mess
DoCmd.Close acForm, f.Name, acSaveNo
Next
Related
I am creating a database for contact information for research participants. In it, I have a form with a command button that is supposed to save 1 of 2 possible reports as a pdf for each participant based on the value of one of the text fields on the form (which is linked to a table where the field is automatically calculated as 0 or 2). Basically if the value of this field is 0 then I want the "UnsignedLetter" report saved for that participant or if the value of this field is 2, I want the "SignedLetter" report saved.
I've got most of it working except when it comes to selecting the correct report to save. FindFirst seems to be the closest to being successful but it's not quite right. When I click the button for the code below, the participants coded as 0 get both versions of the report and not just the "UnsignedLetter" version. The same does not happen with the participants coded as 2. For example, on a recordset of 5 people with 3 coded as 2 and 2 coded as 0, I get 3 correct "SignedLetter" pdf's, 2 correct "UnsignedLetter" pdf's, and an additional 2 incorrect "SignedLetter" pdf's. This is the code I'm working with:
Private Sub SaveLetters_Click()
Dim rs As DAO.Recordset
Dim sFolder As String
Dim sFile As String
On Error GoTo Error_Handler
sFolder = Application.CurrentProject.Path & "\"
Set rs = Me.RecordsetClone
With rs
.FindFirst "OncID = 2"
Do While Not .EOF
DoCmd.OpenReport "SignedLetter", acViewPreview, , "[ID]=" & ![ID],
acHidden
sFile = Nz(![UNumber], "") & "_signed" & ".pdf"
sFile = sFolder & sFile
DoCmd.OutputTo acOutputReport, "SignedLetter", acFormatPDF, sFile, , , ,
acExportQualityPrint
DoCmd.Close acReport, "SignedLetter"
.MoveNext
Loop
End With
With rs
.FindFirst "OncID = 0"
Do While Not .EOF
DoCmd.OpenReport "UnsignedLetter", acViewPreview, , "[ID]=" & ![ID], acHidden
sFile = Nz(![UNumber], "") & "_unsigned" & ".pdf"
sFile = sFolder & sFile
DoCmd.OutputTo acOutputReport, "UnsignedLetter", acFormatPDF, sFile, , , ,
acExportQualityPrint
DoCmd.Close acReport, "UnsignedLetter"
.MoveNext
Loop
End With
MsgBox "Letters Sent to File", vbOKOnly + vbInformation, "Task Completed"
Application.FollowHyperlink sFolder
Error_Handler_Exit:
On Error Resume Next
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
Exit Sub
Error_Handler:
If Err.Number <> 2501 Then
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: cmd_GenPDFs_Click" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
End If
Resume Error_Handler_Exit
End Sub
I've been searching for 2 days at this point and I can't find any solutions. I've tried doing the 2 With rs's separately, using 1 With rs as after the Then portion of an If .NoMatch statement for the other, changing the calculation so it results in text and not a number, and anything else I can think of or find online. I feel like I'm within throwing distance of tears at this point and would really appreciate any help you guys have.
There is no need for FindFirst. Most of the code for both reports is the same. Use an If Then Else and a variable to select appropriate report and dynamically execute commands.
Dim sRpt As String
With Me.RecordsetClone
Do While Not .EOF
If !OncID = 0 Then
sRpt = "Unsigned"
Else
sRpt = "Signed"
End If
DoCmd.OpenReport sRpt & "Letter", acViewPreview, , "[ID]=" & ![ID], acHidden
DoCmd.OutputTo acOutputReport, , acFormatPDF, _
CurrentProject.Path & "\" & Nz(![UNumber], "") & "_" & sRpt & ".pdf"
DoCmd.Close
.MoveNext
Loop
End With
The code below creates an email. It only works on the first record of the db. Also, the code puts all of the fields in the body. I would like it to only put the fields that have "Request from Finance" in the field.
Private Sub cmdEMail_Click()
On Error GoTo cmdEMail_Click_Error
Dim OutApp As Object
Dim strEMail As String
Dim OutMail As Object
Dim strbody As String
strEMail = Me.EMail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Please add the following time codes to Oracle for Lilly Project 1005894. Thank you!" & vbCrLf _
& "" & vbCrLf & "INSTRUCTIONS:" & vbCrLf _
& "" & vbCrLf & "Make sure the Task Description starts with EU. This is automatically added by entering EU in the Contract field on the form." & vbCrLf _
& "" & vbCrLf & "If you wish to keep track of your time code requests, CC: yourself on the e-mail and considering entering a compound name or other identifier in the subject line. Alternatively, save a copy of the spreadsheet with your time codes to your desktop." & vbCrLf _
& "" & vbCrLf & "WRITING TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![WriterTaskNumberName] & vbCrLf _
& "" & vbCrLf & "ADD DRAFT TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![AddDraftTaskNumberName] & vbCrLf _
& "" & vbCrLf & "EDIT TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![EditTaskNumberName] & vbCrLf _
& "" & vbCrLf & "QUALITY REVIEW TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![DataIntegrityQRTaskNumber] & vbCrLf _
& "" & vbCrLf & "Task Description =" & [Forms]![frm_Regulatory]![Text186] & vbCrLf
On Error Resume Next
If Me.ActiveWritingCode = "Request from Finance" Then
With OutMail
.To = strEMail
.CC = ""
.BCC = ""
.Subject = "Lilly EU 1005894 Time Code Request"
.Body = strbody & vbNewLine & .Body
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
End If
On Error GoTo 0
Exit Sub
cmdEMail_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdEMail_Click of Sub Form_frm_Regulatory"
End Sub
Here is a generic script to loop through records in a table.
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Contacts")
'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until rs.EOF = True
'Perform an edit
'rs.Edit
'rs!VendorYN = True
'rs("VendorYN") = True 'The other way to refer to a field
'rs.Update
'Save contact name into a variable
'sContactName = rs!FirstName & " " & rs!LastName
'Move to the next record. Don't ever forget to do this.
rs.MoveNext
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "Finished looping through records."
rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
Here is another example which is quite good.
https://msdn.microsoft.com/en-us/library/bb243789(v=office.12).aspx
Im working on a form that sends an email on the click of a command button, but after the email is made the text boxes the user must fill in do not automatically clear out. I have provided the code I have below. Is there some other kind of clearing command I am missing maybe?
Thanks in advance :)
On Error GoTo errhandle
Me.Filter = "CurrentDate= #" & Format(Me!CurrentDate, "yyyy\-mm\-dd") & "# and DiscoverTime= '" & Me!DiscoverTime & "' and TailNumber= '" & Me!TailNumber & "' and FleetID= '" & Me!FleetID & "'"
Me.FilterOn = True
DoCmd.SendObject acSendForm, "frmETIC", acFormatPDF, "email", "", "", "Recovery Report", "Attached is the submitted Recovery Report"
exiterr:
Exit Sub
errhandle:
If Err.Number <> 2501 Then
MsgBox ("Email cancelled!")
End If
Resume exiterr
Me.CurrentDate = Null
Me.DiscoverTime = Null
Me.TailNumber = Null
Me.FleetID = Null
You are exiting the Sub before clearing. Try the following.
On Error GoTo errhandle
Me.Filter = "CurrentDate= #" & Format(Me!CurrentDate, "yyyy\-mm\-dd") & "# and DiscoverTime= '" & Me!DiscoverTime & "' and TailNumber= '" & Me!TailNumber & "' and FleetID= '" & Me!FleetID & "'"
Me.FilterOn = True
DoCmd.SendObject acSendForm, "frmETIC", acFormatPDF, "email", "", "", "Recovery Report", "Attached is the submitted Recovery Report"
Me.CurrentDate = vbNullString
Me.DiscoverTime = vbNullString
Me.TailNumber = vbNullString
Me.FleetID = vbNullString
exiterr:
Exit Sub
errhandle:
If Err.Number <> 2501 Then
MsgBox ("Email cancelled!")
End If
Resume exiterr
i am creating a .vbs file that should open access, and inside access a form call "Issue Details", but passing a parameter, meaning that if i have 10 issues in my "Issues" table a vbs file is created for each one and when clicked should open the right record(would be one ID for each record in the table). It is so far opening access and it is opening the form(Issue Details) but it is blank. What am i missing? Help, getting crazy here ... Check code below. The weird thing here is that if i double click it again it will refresh and open the right record without opening anymore windows.. How can i fix that? I dont want to do it twice :)
Public Sub sendMRBmail(mrbid)
DoCmd.OpenForm "Issue Details", , , "[ID] = " & mrbid
End Sub
Private Sub Create_Click()
On Error GoTo Err_Command48_Click
Dim snid As Integer
snid = Me.ID
Dim filename As String
filename = "S:\Quality Control\vbs\QC" & snid & ".vbs"
Dim proc As String
proc = Chr(34) & "sendMRBmail" & Chr(34)
Dim strList As String
strList = "On Error Resume Next" & vbNewLine
strList = strList & "dim accessApp" & vbNewLine
strList = strList & "set accessApp = createObject(" & Chr(34) & "Access.Application" & Chr (34)")" & vbNewLine
strList = strList & "accessApp.OpenCurrentDataBase(" & Chr(34) & "S:\Quality Control\Quality DB\Quality Database.accdb" & Chr(34) & ")" & vbNewLine
strList = strList & "accessApp.Run " & proc & "," & Chr(34) & snid & Chr(34) & vbNewLine
strList = strList & "set accessApp = nothing" & vbNewLine
Open filename For Output As #1
Print #1, strList
Close #1
Err_Command48_Click:
If Err.Number <> 0 Then
MsgBox "Email Error #: " & Err.Number & ", " & "Description: " & Err.Description
Exit Sub
End If
End Sub
This is what is inside a created vbs file
On Error Resume Next
dim accessApp
set accessApp = GetObject("S:\Quality Control\Quality DB\Quality Database.accdb")
accessApp.Run"sendMRBmail","231"
set accessApp = nothing
Thanks to all that made inputs, i already found the answer. I added acFormEdit at the end of my DoCmd and it worked, check below:
DoCmd.OpenForm "Issue Details", , , "[ID] = " & mrbid, acFormEdit
Thanks in advance for any help. I have the following code which when clicked creates an email, inserts the body and customer email address and attaches a copy of the invoice. I have two questions, one is it possible to change the name of the attached file, at the moment it's just invoiceF.pdf could do with it being the reference of the delivery. AND secondly, is it possible to catch the result of the send mail? I know if the email isn't sent, just closed, access puts an information box up saying "The send object action was cancelled", i want to catch the "successfully sent" confirmation and add today's date to a box [invoiceemailed]. Thanks to anyone in advance of their help :)
Private Sub emailinvoiceF_Click()
On Error GoTo Err_emailinvoiceF_Click
If MsgBox("Email the invoice?", vbYesNo) = vbYes Then
Dim strMessage
strMessage = "Dear " & First & " " & Last & "," _
& vbCrLf & vbCrLf & "Thank you for your order: (" & DeliveryID & "), please find attached invoice." _
& vbCrLf & vbCrLf & "If you require any further information please do not hesitate to contact us." _
& vbCrLf & vbCrLf & "Kind Regards," _
& vbCrLf & vbCrLf & "SMI Hardwoods" _
& vbCrLf & vbCrLf & "Tel: 01206 396725" _
& vbCrLf & vbCrLf & "www.smi-hardwoods.com" _
Dim stDocName As String
stDocName = "InvoiceF"
DoCmd.SendObject acReport, stDocName, acFormatPDF, [E-mail address], , , "SMI Hardwoods Invoice Ref:" & DeliveryID & ".pdf", strMessage
End If
Exit_emailinvoiceF_Click:
Exit Sub
Err_emailinvoiceF_Click:
MsgBox Err.Description
Resume Exit_emailinvoiceF_Click
End Sub
DoCmd.SendObject command is very limited. It does not allow you attaching files from disk. Because of this limitation you have no control over the file name and number of files to be attached using DoCmd.SendObject.
You may find this article helpful: http://msdn.microsoft.com/en-us/library/aa167323(v=office.11).aspx.
I used Outlook.Application object in the past and found it OK. It allows to have some user interaction before sending an email. Also, it goes straight into Outlook so tracking might be easier. This approach has its own cons, though.
As per your question regarding the Success message, you can add the following to your code:
....
DoCmd.SendObject acReport, stDocName, acFormatPDF, [E-mail address], , , "SMI Hardwoods Invoice Ref:" & DeliveryID & ".pdf", strMessage
'Display success message
MsgBox("Successfully sent on: " & Date())
End If
Exit_emailinvoiceF_Click:
Exit Sub
...