Why isn't this working!?! Apparently my database can't find the field "" referred to in your expression.? signed, rather frustrated - ps.
Private Sub Command17_Click()
On Error GoTo Err_Command17_Click
Dim rst As DAO.Recordset
Dim strEmailAddress
Set rst = CurrentDb.OpenRecordset([CourseRosterMaterialsEmail_Query])
Do Until rst.EOF
strEmailAddress = strEmailAddress & rst([CourseRosterMaterialsEmail_Query].[Email]) & ";"
rst.MoveNext
Loop
strEmailAddress = Left(strEmailAddress, Len(strEmailAddress) - 1)
DoCmd.SendObject , , acFormatRTF, strEmailAddress, _
, , [CourseTitle], [Forms]![CourseRosterMaterials_Form]![Details], False, False
rst.Close
Set rst = Nothing
Exit_Command17_Click:
Exit Sub
Err_Command17_Click:
MsgBox Err.Description
Resume Exit_Command17_Click
End Sub
Try this:
Private Sub Command17_Click()
On Error GoTo Err_Command17_Click
Dim rst As DAO.Recordset
Dim strEmailAddress
Set rst = CurrentDb.OpenRecordset([CourseRosterMaterialsEmail_Query])
Do Until rst.EOF
strEmailAddress = strEmailAddress & rst("Email") & ";"
rst.MoveNext
Loop
strEmailAddress = Left(strEmailAddress, Len(strEmailAddress) - 1)
DoCmd.SendObject , , acFormatRTF, strEmailAddress, _
, , [CourseTitle], [Forms]![CourseRosterMaterials_Form]![Details], False, False
rst.Close
Set rst = Nothing
Exit_Command17_Click:
Exit Sub
Err_Command17_Click:
MsgBox Err.Description
Resume Exit_Command17_Click
End Sub
Usually to refer to fields in Recordsets you need to do this:
rst("FieldName") 'May be ambiguous
rst("FieldAliasName") 'Only if you use aliases
rst("tablename.fieldname") 'I'm actually not sure if this always works
rst("[field name]") 'Use brackets for tables with spaces, symbols, or reserved words
Related
I have created a txt file to support the message body of the vbscript but it only reads the last line of the messagebody.txt
WScript.Sleep 100
Set WshShell=WScript.CreateObject("WScript.Shell")
Set objShell=WScript.CreateObject("WScript.Shell")
set objOutlook=CreateObject("Outlook.Application")
Set objMail=CreateObject("CDO.Message")
Set objMail=objOutlook.CreateItem(0)
strDesktop = WshShell.SpecialFolders("Desktop")
Set objFileToReadTo = CreateObject("Scripting.FileSystemObject").OpenTextFile(strDesktop + "\\send email with attachment\List_To.txt",1)
Set objFileToReadCC = CreateObject("Scripting.FileSystemObject").OpenTextFile(strDesktop + "\\send email with attachment\List_CC.txt",1)
Set objFileToReadSubject = CreateObject("Scripting.FileSystemObject").OpenTextFile(strDesktop + "\\send email with attachment\List_Subject.txt",1)
Set objFileToReadBody = CreateObject("Scripting.FileSystemObject").OpenTextFile(strDesktop + "\\send email with attachment\Email Body.txt",1)
Set objFileToReadAttachments = CreateObject("Scripting.FileSystemObject").OpenTextFile(strDesktop + "\\send email with attachment\List_Attachments_withFileExtension.txt",1)
Dim strLineTo
Dim strLineCC
Dim strLineSubject
Dim strLineBody
Dim strLineAttachments
objMail.Display
WScript.Sleep 10
do while not objFileToReadTo.AtEndOfStream
strLineTo = objFileToReadTo.ReadLine()
objMail.To=strLineTo
loop
objFileToReadTo.Close
WScript.Sleep 10
do while not objFileToReadCC.AtEndOfStream
strLineCC = objFileToReadCC.ReadLine()
objMail.cc = strLineCC
loop
objFileToReadCC.Close
'41
WScript.Sleep 10
do while not objFileToReadSubject.AtEndOfStream
strLineSubject = objFileToReadSubject.ReadLine()
objMail.Subject = strLineSubject
loop
objFileToReadSubject.Close
'48
WScript.Sleep 10
do while not objFileToReadBody.AtEndOfStream
strLineBody = objFileToReadBody.ReadLine()
objMail.Body = strLineBody & vbCRLF
loop
objFileToReadBody.Close
'55
WScript.Sleep 10
do while not objFileToReadAttachments.AtEndOfStream
strLineAttachments = objFileToReadAttachments.ReadLine()
objMail.Attachments.Add(strLineAttachments)
loop
objFileToReadAttachments.Close
'62
'objShell.Sendkeys "%s"
WScript.Sleep 40
'objShell.SendKeys "{TAB}"
'objShell.SendKeys "{UP}"
'objShell.SendKeys "{Enter}"
'set MyEmail=nothing
'objOutlook.Quit
'Set objMail = Nothing
'Set objOutlook = Nothing
and here is my messagebody.txt
Hi,
Testing vbscript
Regards,
abcd
It only reads the last ABCD and displays the same on the oulook window.
How do I make the scipt understand multiple lines?
I really don't know why you have used different text files for storing ToList, CCList, body etc. but if you are sure about using this approach, I won't change it.
I am just pointing out why you are not getting the full text in the email body. Replace the following code:
do while not objFileToReadBody.AtEndOfStream
strLineBody = objFileToReadBody.ReadLine() 'Here you are just overwriting the value contained in strLineBody in each loop iteration. Hence, in the end, only last line is left in this variable
objMail.Body = strLineBody & vbCRLF
loop
WITH
objMail.Body = objFileToReadBody.readAll
In the loop you replace the Body with each line you read, when you should be appending to it. Switch this line;
objMail.Body = strLineBody & vbCRLF
to be;
objMail.Body = objMail.Body & strLineBody & vbNewLine
If you forgo the loop and use ReadAll (as #Gurman has suggested), bear in mind that while this will be fine for minimal text, larger text files will make the process less efficient then looping through each line as you have started to do already.
I'm trying to retrieve a incident reference number when I run a vbscript. The script opens the ticket with the script ticket values in the code but it returns the following error: Error: Necessary object: 'oWSResponseDoc.selectSingleNode(...)'
The code I am using is
' Perform the insert and check the status
If Not wsInsertIncident.Post Then
WScript.Echo "Error=" & wsInsertIncident.Status
WScript.Echo wsInsertIncident.StatusText
WScript.Quit
End If
Dim strIncidentSysId, strIncidentNumber
strIncidentSysId = wsInsertIncident.GetValue("sys_id")
strIncidentNumber = wsInsertIncident.GetValue("number")
WScript.Echo "Inserted: " & strIncidentNumber
I know this worked in the past but today it doesn't. I don't know what has changed. Full script can be seen here:
https://servicenowsoap.wordpress.com/2013/10/26/vb-script/
Can you please help me? Many thanks!
You need to use the SetMethod function before you can insert an incident. This is used to determine what action to take when you make the web call.
I tested this on a demo instance and it created the incident and returned a number.
' Specify the ticket values
Dim wsInsertIncident : Set wsInsertIncident = New ServiceNowDirectWS
wsInsertIncident.SetMethod "incident", "insert"
wsInsertIncident.SetValue "short_description", "Demo WS Incident"
wsInsertIncident.SetValue "description", "Demo WS Incident"
wsInsertIncident.SetValue "caller_id", "Abel Tuter"
wsInsertIncident.SetValue "category", "hardware"
wsInsertIncident.SetValue "subcategory", "mouse"
' Perform the insert and check the status
If Not wsInsertIncident.Post Then
WScript.Echo "Error=" & wsInsertIncident.Status
WScript.Echo wsInsertIncident.StatusText
WScript.Quit
End If
Dim strIncidentSysId, strIncidentNumber
strIncidentSysId = wsInsertIncident.GetValue("sys_id")
strIncidentNumber = wsInsertIncident.GetValue("number")
WScript.Echo "Inserted: " & strIncidentNumber
Dim objShell : Set objShell = Wscript.CreateObject("Wscript.Shell")
objShell.Popup "Inserted: " & strIncidentNumber,, "ServiceNow ticket!"
I want to copy MailItems from one Outlook folder to another.
When I run the following code it takes a long time like i.e. 5 seconds per MailItem even if the MailItems are only mails with few lines < 5kB.
I do this in the folders of an IMAP EMail account.
Sometimes I also get an error that an item can not be moved but only be copied.
What do I do wrong? This should be simple.
Currently the code creates first a copy of the mail in the original folder and then I move this copy. I would prefer to create a copy directly in the destination folder.
If I do this manually by dragging and dropping the mails (holding Ctrl to make a copy) this works fast like maybe 1s for 3 mails.
Sub CopyMailsToOtherFolder()
On Error GoTo CopyMailsToOtherFolder_Err
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Dim TestFolder As Outlook.Folder
Dim OutFolder As Outlook.Folder
Dim objItem As Object 'Note that myItem is declared as type Object so that it can represent all types of Outlook items including meeting request and task request items.
Dim MsgOrg As Outlook.MailItem
Dim MsgCopy As Outlook.MailItem
Dim lngI As Long
Set TestFolder = objNS.Folders("Edgar").Folders("Inbox")
Set OutFolder = objNS.Folders("Edgar").Folders("Inbox").Folders("TestOut")
Debug.Print "Start: " & Time()
'For lngI = 1 To TestFolder.Items.Count
For lngI = 1 To 3
Set objItem = TestFolder.Items(lngI)
If TypeName(objItem) = "MailItem" Then
Set MsgOrg = objItem
Debug.Print " Org: " & MsgOrg.Subject
Set MsgCopy = MsgOrg.Copy 'Creates copy in original folder
MsgCopy.Move OutFolder
End If
Next
Debug.Print "Done"
CopyMailsToOtherFolder_Exit:
Debug.Print "Exit: " & Time()
Exit Sub
CopyMailsToOtherFolder_Err:
Debug.Print "Error " & Err.Number & " - " & Err.Description
Resume CopyMailsToOtherFolder_Exit
End Sub
So, I'm using (after modification) this code, from here: How to set recurring schedule for xlsm file using Windows Task Scheduler
My error: Runtime error: Unknown runtime error.
I've searched far and wide to find an way to close the Excel process, but almost everybody uses .Quit sadly it gives the above error. I've also tried .Close, but that is not recognized
' Create a WshShell to get the current directory
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Create an Excel instance
Dim myExcelWorker
Set myExcelWorker = CreateObject("Excel.Application")
' Disable Excel UI elements
myExcelWorker.DisplayAlerts = False
myExcelWorker.AskToUpdateLinks = False
myExcelWorker.AlertBeforeOverwriting = False
myExcelWorker.FeatureInstall = msoFeatureInstallNone
' Tell Excel what the current working directory is
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = myExcelWorker.DefaultFilePath
strPath = "C:\Users\hviid00m\Desktop"
myExcelWorker.DefaultFilePath = strPath
' Open the Workbook specified on the command-line
Dim oWorkBook
Dim strWorkerWB
strWorkerWB = strPath & "\Status Report (Boxplots) TEST.xlsm"
Set oWorkBook = myExcelWorker.Workbooks.Open (strWorkerWB, , , , , , True)
' Build the macro name with the full path to the workbook
Dim strMacroName
strMacroName = "Refresh"
on error resume next
myExcelWorker.Run strMacroName
if err.number <> 0 Then
WScript.Echo "Fejl i macro"
End If
err.clear
on error goto 0
oWorkBook.Save
' Clean up and shut down
' Don’t Quit() Excel if there are other Excel instances
' running, Quit() will shut those down also
myExcelWorker.Quit <--- ERROR
Set oWorkBook = Nothing
Set myExcelWorker = Nothing
Set WshShell = Nothing
Found some code on a different side.
The reason why (as far as I understood) is that .Quit and .Close is for VBA not VBS.
' Clean up and shut down
' Don’t Quit() Excel if there are other Excel instances
' running, Quit() will shut those down also
Dim objWMIService, objProcess, colProcess
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = " & "'EXCEL.EXE'")
For Each objProcess in colProcess
objProcess.Terminate()
Next`
Set oWorkBook = Nothing
Set myExcelWorker = Nothing
Set WshShell = Nothing
I am creating an Excel UserForm that creates a separate email for up to 500 recipients.
There are 4 columns on the worksheet: Name(Column A), Email(Column B), Value 1(Column C).
The code uses the For and Next loop style, where r is declared as an Integer (r = 2 To 500) and with the MailItem Object, .To =Cells(r,2).
The issue I have is attempting to incorporate values from a range (Column C) that replace special characters placed in the text box used to create the body of the email.
So if I were to type, Hello, There were ^&^ transactions that failed yesterday. and hit a command button used for "Send", it would send an email to the each email address listed in Column B and replace ^&^ with the value in Column C to each individual email address (each row).
Below is the VBA code as an example. There are a lot of other declared variables that I did not mention of course to keep this inquiry as short as possible.
Dim Signature As String, EmailSensitivity As String, EmailImportance As String
Dim Greeting As String, Punctuation As String, Security As String
Sub SendButton1_Click()
If SubjectText = vbNullString Then
If EmailBody1 = vbNullString Then
MsgBox "Form Incomplete:" & vbCrLf & vbCrLf & _
"No Subject or Email Text.", vbOKOnly
Exit Sub
End If
End If
If SubjectText = vbNullString Then
MsgBox "Form Incomplete:" & vbCrLf & vbCrLf & _
"Please enter Subject.", vbOKOnly
Exit Sub
End If
If EmailBody1 = vbNullString Then
MsgBox "Form Incomplete:" & vbCrLf & vbCrLf & _
"Please enter Email Text."
Exit Sub
End If
If SignatureText1 = vbNullString Then
Continue = MsgBox("Your email contains no signature." & vbCrLf & vbCrLf & _
"Are you sure you wish to proceed?", vbYesNo)
If Continue = vbNo Then
Exit Sub
End If
End If
Dim OutApp As Object, OutMail As Object
Dim r As Integer
Application.ScreenUpdating = False
For r = 2 To 501
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
On Error Resume Next
With OutMail
.Subject = Security & SubjectText.Value
.Body = EmailBody1.Value & vbCrLf & vbCrLf & _
SignatureText1.Value
.To = Cells(r, 2)
.Attachements.Add AttachmentText1.Value
.Importance = EmailImportance
.Sensitivity = EmailSensitivity
.Send
End With
Next r
Set OutApp = Nothing
Application.ScreenUpdating = True
Sheet1.Range("A2:B501").Clear
Continue = MsgBox("You have successfully generated a mass email!" & vbCrLf & vbCrLf & _
"Would you like to generate another email?", vbYesNo)
If Continue = vbNo Then
Application.Quit
End If
End Sub
I am still an amateur, so I'm working on cleaning a lot of unnecessary code, but this inquiry is mainly on replacing the special character with the value listed in each row.
This is my first time actually posting an inquiry on a forum, so please let me know if I am not following the correct procedure as your help is much appreciated.
It might be as simple as this, using the Replace function:
...
With OutMail
.Subject = Security & SubjectText.Value
.Body = Replace(EmailBody1.Value,"^&^",Cells(r, 3)) & _
vbCrLf & vbCrLf & SignatureText1.Value
...
Unrelated to this, but importat: On Error Resume Next means the sending (and any operation after that) will silently fail. This will make future debugging more difficult, frustrating and expensive. You should at least log relevant details about what error occured, and for what row in the sheet. And be sure to re-enable error-checking with on error goto 0 or similar after the part of your program that might fail unexpectedly.