Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help creating object in excel VBA
Hello,
I am building an VBA macro that will allow me to send Bulk Email, using MS Outlook, and using an word.doc as the message body. When i create a new object of words i have no problem, but if i try to create an object of MS Outlook i get the error 429 if you are familiar with that, "You can pull a search on google using, "VBA error 429". Basically it works like this, i need to be able to send out around 1,500 per day what it does is extract the information from excel spreadsheet cell. I click on a button in excel then it will dump every value in every cell into an array. Then it will manipulate a word.doc document by inserting into bookmarks values from the array. then after one row is processed it will then send it to outlook to be processes for outgoing mail. As i stated before the word application has no problem working, but if i try to initiate outlook then i get the error. I never thought VBA would be so complicated. If anyone has any suggestions or better way i could go about this i would surely appreciate it. ~~~~~~~~~~~Below is the code~~~~~~~~~~~~~ Option Explicit Sub BtnSendEmail_Click() Dim name, phone, email, time, _ dated As String Dim confirm, sent As Boolean Dim status As Boolean ' array = {name, phone, email, date, time, confirm, sent} Dim rowColArray() As String Dim row As Double, col As Double ' Debug.Print DBEngine.Version ' Step 1 status = GetApptRec(rowColArray, row, col) ' ' TODO: at end of coding delete this section was used for ' ' TODO: testing purposes ' ' test values to see if it was inputted ' Dim nr, nc As Integer ' For nr = 1 To row ' For nc = 1 To col ' ' MsgBox rowColArray(nr, nc) ' Next nc ' Next nr ' ' MsgBox "There are " & row & " rows " & _ ' "and " & col & " Columns", vbOKOnly, _ ' "Number of Row and Columns" ' TODO: Call CreateEmailMsg (Create Email Message Module) Call CreateEmailMsg(rowColArray) ' TODO: Call SendMsg (Send Email Message) End Sub Public Function GetApptRec(ByRef rowColArray() As String, _ ByRef row As Double, ByRef col As Double) As Boolean Dim r, c As Integer ' Dim rowColArray() As String ' Dim row, col As Double Dim strValue As String ' Determine the total number of rows and columns col = fLastColWithData() row = fLastRowWithData() ReDim rowColArray(row, col) For r = 1 To row For c = 1 To col ' fill varaible with the values from the cells ' starting at row 2 strValue = Cells(r, c) rowColArray(r, c) = strValue Next c Next r GetApptRec = True End Function ' GetApptRec Public Function CreateEmailMsg _ (ByRef rowColArray() As String) As String Dim r As Double, c As Integer, row As Double, col As Integer Dim name As String, dated As String, timed As String, _ email As String Dim oGlobalWordApp As Object Dim oOutlook As Object ' Dim oOutlook As Outlook.Application Set oGlobalWordApp = CreateObject("Word.Application") oOutlook = CreateObject("Outlook.Application") ' oOutlook = New Outlook.Application oGlobalWordApp.Visible = True row = UBound(rowColArray, 1) col = UBound(rowColArray, 2) On Error GoTo errorHandler ' TODO: Call GetWrdDoc (Get Word Document) Documents.Open ("C:\docs\copy of crm.doc") ' TODO: FrmDtTm (Format Date And Time) ' TODO: Call ManipMsg (Manipulate Message) ' array = {name, phone, email, date, time, confirm, sent} ' bookmark. exists (does it exist?): For r = 1 To row ' make sure it is ok to send it before sending it Dim sent, confirmed sent = rowColArray(r, 7) confirmed = rowColArray(r, 6) If confirmed = 1 And sent = 0 Then For c = 1 To col name = rowColArray(r, 1) dated = rowColArray(r, 4) timed = rowColArray(r, 5) email = rowColArray(r, 3) If Word.ActiveDocument.Bookmarks.Exists("Name") = True Then Word.ActiveDocument.Bookmarks("Name").Select Word.Selection.TypeText Text:=name End If If Word.ActiveDocument.Bookmarks.Exists("Date1") = True Then Word.ActiveDocument.Bookmarks("Date1").Select Word.Selection.TypeText Text:=dated End If If Word.ActiveDocument.Bookmarks.Exists("Date2") = True Then Word.ActiveDocument.Bookmarks("Date2").Select Word.Selection.TypeText Text:=dated End If If Word.ActiveDocument.Bookmarks.Exists("Time1") = True Then Word.ActiveDocument.Bookmarks("Time1").Select Word.Selection.TypeText Text:=time End If If Word.ActiveDocument.Bookmarks.Exists("Time2") = True Then Word.ActiveDocument.Bookmarks("Time2").Select Word.Selection.TypeText Text:=time End If ' TODO: Call SendMsg (Send Email Message) Call SendMsg(, email) Next c End If Next r errorHandler: MsgBox Err.Number & " " & Err.Description oGlobalWordApp.Quit oGlobalWordApp = Nothing End Function ' CreateEmailMsg Public Sub SendMsg(Optional ByVal msgBody As Object, _ Optional ByVal email As String) ' Dim bStarted As Boolean ' Dim oOutlookApp As Object Dim oItem As Outlook.MailItem ' On Error Resume Next On Error GoTo errorHandler 'Get Outlook if it's running ' Set oOutlookApp = GetObject(, "Outlook.Application") ' If Err < 0 Then 'Outlook wasn't running, start it from code ' Set oOutlookApp = CreateObject("Outlook.Application") ' bStarted = True ' End If 'Create a new mailitem Set oItem = oOutlookApp.CreateItem(olMailItem) With oItem 'Set the recipient for the new email .To = email 'Set the recipient for a copy '.CC = " 'Set the subject .subject = "Concerning Appointment with Dustin Swiger" 'The content of the document is used as the body for the email .Body = ActiveDocument.Content .Send End With ' If bStarted Then ' 'If we started Outlook from code, then close it ' oOutlookApp.Quit ' End If errorHandler: MsgBox Err.Number & " " & Err.Description 'Clean up Set oItem = Nothing Set oOutlookApp = Nothing End Sub ' SendMsg Public Sub GetWrdDoc() End Sub Public Function FrmDtTm(ByVal time As String, _ ByVal dated As String) End Function Public Function ManipMsg(ByVal name As String, _ ByVal msgBody As Object) ' TODO: FindReplaceName (Find & Replace Default String for Name Field) ' TODO: FindReplaceDtTm (Find & Replace Default String for data & time) End Function Private Function FindReplaceName(ByVal name As String, _ ByVal msgBody As Object) End Function Private Function FindReplaceDtTm(ByVal dated As String, _ ByVal time As String, ByVal msbBody As Object) End Function Public Function fLastRowWithData() Dim excelLastCell Dim LastRowWithData Dim row Set excelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell) ' Determine the last row with data in it(must also copy above para for ' this to work) LastRowWithData = excelLastCell.row row = excelLastCell.row Do While Application.CountA(ActiveSheet.Rows(row)) = 0 And row < 1 row = row - 1 Loop LastRowWithData = row ' row number fLastRowWithData = LastRowWithData End Function Public Function fLastColWithData() Dim excelLastCell Dim lastColWithData Dim col Set excelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell) ' determine the last column with data in it(must also copy the top ' para for this to work) lastColWithData = excelLastCell.Columns col = excelLastCell.Column Do While Application.CountA(ActiveSheet.Columns(col)) = 0 And col < 1 col = col - 1 Loop lastColWithData = col ' column number fLastColWithData = lastColWithData End Function 'TODO: I need to redo this to make this work with the sendMsg module Public Sub chkSent(ByRef rowColArray() As String, row, col) Dim r Dim c As Integer ' initiate c to total amount of columns in the array c = UBound(rowColArray, 2) ' array = {name, phone, email, date, time, confirm, sent} For r = 1 To UBound(rowColArray, 1) Value = rowcountarray(r, c) If Value = 1 Then Dim cs For cs = 1 To c rowcountarray(r, cs) = "" Next cs End If Next r End Sub 'TODO: I need to redo this to make this work with the sendMsg module Public Sub chkConfirmed(ByRef rowColArray() As String, row, col) Dim r Dim c As Integer ' initiate c to total amount of columns in the array c = UBound(rowColArray, 2) c = c - 1 ' array = {name, phone, email, date, time, confirm, sent} For r = 1 To UBound(rowColArray, 1) Value = rowcountarray(r, c) If Value = 1 Then Dim cs For cs = 1 To c rowcountarray(r, cs) = "" Next cs End If Next r End Sub Public Sub SendOutlookMail(ByVal subject As String, ByVal Recipient As _ String, ByVal Message As String) On Error GoTo errorHandler Dim oLapp As Object Dim oItem As Object oLapp = CreateObject("Outlook.application") oItem = oLapp.CreateItem(0) ' With oItem .subject = subject .To = Recipient .Body = Message ' .Send() End With ' oLapp = Nothing oItem = Nothing ' ' reset the resend boolean resend = False Exit Sub errorHandler: oLapp = Nothing oItem = Nothing ' reset the resend boolean resend = False Exit Sub End Sub ' SendOutlookMail() Basically -- Digit Solver„˘ |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help creating object in excel VBA
Blimey, you don't want much do you <vbg
Basically, to use Outlook you need to create an Outlook object, just as you do with Word, so this line oOutlook = CreateObject("Outlook.Application") needs to be Set oOutlook = CreateObject("Outlook.Application") When I tried it I found a couple of other problems. This line Documents.Open ("C:\docs\copy of crm.doc") needs to reference an object, so I think it should be oGlobalWordApp.Documents.Open ("C:\docs\copy of crm.doc") and also you kkep referencing Word via lines such as Word.ActiveDocument.Bookmarks("Name").Select as Word is not defined, I think they should all be of the form oGlobalWordApp.ActiveDocument.Bookmarks("Name").Se lect If you used Option Explicit, this would not have arisen, you would get a compile error. -- HTH Bob Phillips (remove nothere from email address if mailing direct) "Digit Solver" wrote in message ... Hello, I am building an VBA macro that will allow me to send Bulk Email, using MS Outlook, and using an word.doc as the message body. When i create a new object of words i have no problem, but if i try to create an object of MS Outlook i get the error 429 if you are familiar with that, "You can pull a search on google using, "VBA error 429". Basically it works like this, i need to be able to send out around 1,500 per day what it does is extract the information from excel spreadsheet cell. I click on a button in excel then it will dump every value in every cell into an array. Then it will manipulate a word.doc document by inserting into bookmarks values from the array. then after one row is processed it will then send it to outlook to be processes for outgoing mail. As i stated before the word application has no problem working, but if i try to initiate outlook then i get the error. I never thought VBA would be so complicated. If anyone has any suggestions or better way i could go about this i would surely appreciate it. ~~~~~~~~~~~Below is the code~~~~~~~~~~~~~ Option Explicit Sub BtnSendEmail_Click() Dim name, phone, email, time, _ dated As String Dim confirm, sent As Boolean Dim status As Boolean ' array = {name, phone, email, date, time, confirm, sent} Dim rowColArray() As String Dim row As Double, col As Double ' Debug.Print DBEngine.Version ' Step 1 status = GetApptRec(rowColArray, row, col) ' ' TODO: at end of coding delete this section was used for ' ' TODO: testing purposes ' ' test values to see if it was inputted ' Dim nr, nc As Integer ' For nr = 1 To row ' For nc = 1 To col ' ' MsgBox rowColArray(nr, nc) ' Next nc ' Next nr ' ' MsgBox "There are " & row & " rows " & _ ' "and " & col & " Columns", vbOKOnly, _ ' "Number of Row and Columns" ' TODO: Call CreateEmailMsg (Create Email Message Module) Call CreateEmailMsg(rowColArray) ' TODO: Call SendMsg (Send Email Message) End Sub Public Function GetApptRec(ByRef rowColArray() As String, _ ByRef row As Double, ByRef col As Double) As Boolean Dim r, c As Integer ' Dim rowColArray() As String ' Dim row, col As Double Dim strValue As String ' Determine the total number of rows and columns col = fLastColWithData() row = fLastRowWithData() ReDim rowColArray(row, col) For r = 1 To row For c = 1 To col ' fill varaible with the values from the cells ' starting at row 2 strValue = Cells(r, c) rowColArray(r, c) = strValue Next c Next r GetApptRec = True End Function ' GetApptRec Public Function CreateEmailMsg _ (ByRef rowColArray() As String) As String Dim r As Double, c As Integer, row As Double, col As Integer Dim name As String, dated As String, timed As String, _ email As String Dim oGlobalWordApp As Object Dim oOutlook As Object ' Dim oOutlook As Outlook.Application Set oGlobalWordApp = CreateObject("Word.Application") oOutlook = CreateObject("Outlook.Application") ' oOutlook = New Outlook.Application oGlobalWordApp.Visible = True row = UBound(rowColArray, 1) col = UBound(rowColArray, 2) On Error GoTo errorHandler ' TODO: Call GetWrdDoc (Get Word Document) Documents.Open ("C:\docs\copy of crm.doc") ' TODO: FrmDtTm (Format Date And Time) ' TODO: Call ManipMsg (Manipulate Message) ' array = {name, phone, email, date, time, confirm, sent} ' bookmark. exists (does it exist?): For r = 1 To row ' make sure it is ok to send it before sending it Dim sent, confirmed sent = rowColArray(r, 7) confirmed = rowColArray(r, 6) If confirmed = 1 And sent = 0 Then For c = 1 To col name = rowColArray(r, 1) dated = rowColArray(r, 4) timed = rowColArray(r, 5) email = rowColArray(r, 3) If Word.ActiveDocument.Bookmarks.Exists("Name") = True Then Word.ActiveDocument.Bookmarks("Name").Select Word.Selection.TypeText Text:=name End If If Word.ActiveDocument.Bookmarks.Exists("Date1") = True Then Word.ActiveDocument.Bookmarks("Date1").Select Word.Selection.TypeText Text:=dated End If If Word.ActiveDocument.Bookmarks.Exists("Date2") = True Then Word.ActiveDocument.Bookmarks("Date2").Select Word.Selection.TypeText Text:=dated End If If Word.ActiveDocument.Bookmarks.Exists("Time1") = True Then Word.ActiveDocument.Bookmarks("Time1").Select Word.Selection.TypeText Text:=time End If If Word.ActiveDocument.Bookmarks.Exists("Time2") = True Then Word.ActiveDocument.Bookmarks("Time2").Select Word.Selection.TypeText Text:=time End If ' TODO: Call SendMsg (Send Email Message) Call SendMsg(, email) Next c End If Next r errorHandler: MsgBox Err.Number & " " & Err.Description oGlobalWordApp.Quit oGlobalWordApp = Nothing End Function ' CreateEmailMsg Public Sub SendMsg(Optional ByVal msgBody As Object, _ Optional ByVal email As String) ' Dim bStarted As Boolean ' Dim oOutlookApp As Object Dim oItem As Outlook.MailItem ' On Error Resume Next On Error GoTo errorHandler 'Get Outlook if it's running ' Set oOutlookApp = GetObject(, "Outlook.Application") ' If Err < 0 Then 'Outlook wasn't running, start it from code ' Set oOutlookApp = CreateObject("Outlook.Application") ' bStarted = True ' End If 'Create a new mailitem Set oItem = oOutlookApp.CreateItem(olMailItem) With oItem 'Set the recipient for the new email .To = email 'Set the recipient for a copy '.CC = " 'Set the subject .subject = "Concerning Appointment with Dustin Swiger" 'The content of the document is used as the body for the email .Body = ActiveDocument.Content .Send End With ' If bStarted Then ' 'If we started Outlook from code, then close it ' oOutlookApp.Quit ' End If errorHandler: MsgBox Err.Number & " " & Err.Description 'Clean up Set oItem = Nothing Set oOutlookApp = Nothing End Sub ' SendMsg Public Sub GetWrdDoc() End Sub Public Function FrmDtTm(ByVal time As String, _ ByVal dated As String) End Function Public Function ManipMsg(ByVal name As String, _ ByVal msgBody As Object) ' TODO: FindReplaceName (Find & Replace Default String for Name Field) ' TODO: FindReplaceDtTm (Find & Replace Default String for data & time) End Function Private Function FindReplaceName(ByVal name As String, _ ByVal msgBody As Object) End Function Private Function FindReplaceDtTm(ByVal dated As String, _ ByVal time As String, ByVal msbBody As Object) End Function Public Function fLastRowWithData() Dim excelLastCell Dim LastRowWithData Dim row Set excelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell) ' Determine the last row with data in it(must also copy above para for ' this to work) LastRowWithData = excelLastCell.row row = excelLastCell.row Do While Application.CountA(ActiveSheet.Rows(row)) = 0 And row < 1 row = row - 1 Loop LastRowWithData = row ' row number fLastRowWithData = LastRowWithData End Function Public Function fLastColWithData() Dim excelLastCell Dim lastColWithData Dim col Set excelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell) ' determine the last column with data in it(must also copy the top ' para for this to work) lastColWithData = excelLastCell.Columns col = excelLastCell.Column Do While Application.CountA(ActiveSheet.Columns(col)) = 0 And col < 1 col = col - 1 Loop lastColWithData = col ' column number fLastColWithData = lastColWithData End Function 'TODO: I need to redo this to make this work with the sendMsg module Public Sub chkSent(ByRef rowColArray() As String, row, col) Dim r Dim c As Integer ' initiate c to total amount of columns in the array c = UBound(rowColArray, 2) ' array = {name, phone, email, date, time, confirm, sent} For r = 1 To UBound(rowColArray, 1) Value = rowcountarray(r, c) If Value = 1 Then Dim cs For cs = 1 To c rowcountarray(r, cs) = "" Next cs End If Next r End Sub 'TODO: I need to redo this to make this work with the sendMsg module Public Sub chkConfirmed(ByRef rowColArray() As String, row, col) Dim r Dim c As Integer ' initiate c to total amount of columns in the array c = UBound(rowColArray, 2) c = c - 1 ' array = {name, phone, email, date, time, confirm, sent} For r = 1 To UBound(rowColArray, 1) Value = rowcountarray(r, c) If Value = 1 Then Dim cs For cs = 1 To c rowcountarray(r, cs) = "" Next cs End If Next r End Sub Public Sub SendOutlookMail(ByVal subject As String, ByVal Recipient As _ String, ByVal Message As String) On Error GoTo errorHandler Dim oLapp As Object Dim oItem As Object oLapp = CreateObject("Outlook.application") oItem = oLapp.CreateItem(0) ' With oItem .subject = subject .To = Recipient .Body = Message ' .Send() End With ' oLapp = Nothing oItem = Nothing ' ' reset the resend boolean resend = False Exit Sub errorHandler: oLapp = Nothing oItem = Nothing ' reset the resend boolean resend = False Exit Sub End Sub ' SendOutlookMail() Basically -- Digit SolverT |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help creating object in excel VBA
Still having the same problem don't why it is doing this, do you know of any
other way i could go about doing what i need to accomplish? -- Digit Solver„˘ "Bob Phillips" wrote: Blimey, you don't want much do you <vbg Basically, to use Outlook you need to create an Outlook object, just as you do with Word, so this line oOutlook = CreateObject("Outlook.Application") needs to be Set oOutlook = CreateObject("Outlook.Application") When I tried it I found a couple of other problems. This line Documents.Open ("C:\docs\copy of crm.doc") needs to reference an object, so I think it should be oGlobalWordApp.Documents.Open ("C:\docs\copy of crm.doc") and also you kkep referencing Word via lines such as Word.ActiveDocument.Bookmarks("Name").Select as Word is not defined, I think they should all be of the form oGlobalWordApp.ActiveDocument.Bookmarks("Name").Se lect If you used Option Explicit, this would not have arisen, you would get a compile error. -- HTH Bob Phillips (remove nothere from email address if mailing direct) "Digit Solver" wrote in message ... Hello, I am building an VBA macro that will allow me to send Bulk Email, using MS Outlook, and using an word.doc as the message body. When i create a new object of words i have no problem, but if i try to create an object of MS Outlook i get the error 429 if you are familiar with that, "You can pull a search on google using, "VBA error 429". Basically it works like this, i need to be able to send out around 1,500 per day what it does is extract the information from excel spreadsheet cell. I click on a button in excel then it will dump every value in every cell into an array. Then it will manipulate a word.doc document by inserting into bookmarks values from the array. then after one row is processed it will then send it to outlook to be processes for outgoing mail. As i stated before the word application has no problem working, but if i try to initiate outlook then i get the error. I never thought VBA would be so complicated. If anyone has any suggestions or better way i could go about this i would surely appreciate it. ~~~~~~~~~~~Below is the code~~~~~~~~~~~~~ Option Explicit Sub BtnSendEmail_Click() Dim name, phone, email, time, _ dated As String Dim confirm, sent As Boolean Dim status As Boolean ' array = {name, phone, email, date, time, confirm, sent} Dim rowColArray() As String Dim row As Double, col As Double ' Debug.Print DBEngine.Version ' Step 1 status = GetApptRec(rowColArray, row, col) ' ' TODO: at end of coding delete this section was used for ' ' TODO: testing purposes ' ' test values to see if it was inputted ' Dim nr, nc As Integer ' For nr = 1 To row ' For nc = 1 To col ' ' MsgBox rowColArray(nr, nc) ' Next nc ' Next nr ' ' MsgBox "There are " & row & " rows " & _ ' "and " & col & " Columns", vbOKOnly, _ ' "Number of Row and Columns" ' TODO: Call CreateEmailMsg (Create Email Message Module) Call CreateEmailMsg(rowColArray) ' TODO: Call SendMsg (Send Email Message) End Sub Public Function GetApptRec(ByRef rowColArray() As String, _ ByRef row As Double, ByRef col As Double) As Boolean Dim r, c As Integer ' Dim rowColArray() As String ' Dim row, col As Double Dim strValue As String ' Determine the total number of rows and columns col = fLastColWithData() row = fLastRowWithData() ReDim rowColArray(row, col) For r = 1 To row For c = 1 To col ' fill varaible with the values from the cells ' starting at row 2 strValue = Cells(r, c) rowColArray(r, c) = strValue Next c Next r GetApptRec = True End Function ' GetApptRec Public Function CreateEmailMsg _ (ByRef rowColArray() As String) As String Dim r As Double, c As Integer, row As Double, col As Integer Dim name As String, dated As String, timed As String, _ email As String Dim oGlobalWordApp As Object Dim oOutlook As Object ' Dim oOutlook As Outlook.Application Set oGlobalWordApp = CreateObject("Word.Application") oOutlook = CreateObject("Outlook.Application") ' oOutlook = New Outlook.Application oGlobalWordApp.Visible = True row = UBound(rowColArray, 1) col = UBound(rowColArray, 2) On Error GoTo errorHandler ' TODO: Call GetWrdDoc (Get Word Document) Documents.Open ("C:\docs\copy of crm.doc") ' TODO: FrmDtTm (Format Date And Time) ' TODO: Call ManipMsg (Manipulate Message) ' array = {name, phone, email, date, time, confirm, sent} ' bookmark. exists (does it exist?): For r = 1 To row ' make sure it is ok to send it before sending it Dim sent, confirmed sent = rowColArray(r, 7) confirmed = rowColArray(r, 6) If confirmed = 1 And sent = 0 Then For c = 1 To col name = rowColArray(r, 1) dated = rowColArray(r, 4) timed = rowColArray(r, 5) email = rowColArray(r, 3) If Word.ActiveDocument.Bookmarks.Exists("Name") = True Then Word.ActiveDocument.Bookmarks("Name").Select Word.Selection.TypeText Text:=name End If If Word.ActiveDocument.Bookmarks.Exists("Date1") = True Then Word.ActiveDocument.Bookmarks("Date1").Select Word.Selection.TypeText Text:=dated End If If Word.ActiveDocument.Bookmarks.Exists("Date2") = True Then Word.ActiveDocument.Bookmarks("Date2").Select Word.Selection.TypeText Text:=dated End If If Word.ActiveDocument.Bookmarks.Exists("Time1") = True Then Word.ActiveDocument.Bookmarks("Time1").Select Word.Selection.TypeText Text:=time End If If Word.ActiveDocument.Bookmarks.Exists("Time2") = True Then Word.ActiveDocument.Bookmarks("Time2").Select Word.Selection.TypeText Text:=time End If ' TODO: Call SendMsg (Send Email Message) Call SendMsg(, email) Next c End If Next r errorHandler: MsgBox Err.Number & " " & Err.Description oGlobalWordApp.Quit oGlobalWordApp = Nothing End Function ' CreateEmailMsg Public Sub SendMsg(Optional ByVal msgBody As Object, _ Optional ByVal email As String) ' Dim bStarted As Boolean ' Dim oOutlookApp As Object Dim oItem As Outlook.MailItem ' On Error Resume Next On Error GoTo errorHandler 'Get Outlook if it's running ' Set oOutlookApp = GetObject(, "Outlook.Application") ' If Err < 0 Then 'Outlook wasn't running, start it from code ' Set oOutlookApp = CreateObject("Outlook.Application") ' bStarted = True ' End If 'Create a new mailitem Set oItem = oOutlookApp.CreateItem(olMailItem) With oItem 'Set the recipient for the new email .To = email 'Set the recipient for a copy '.CC = " 'Set the subject .subject = "Concerning Appointment with Dustin Swiger" 'The content of the document is used as the body for the email .Body = ActiveDocument.Content .Send End With ' If bStarted Then ' 'If we started Outlook from code, then close it ' oOutlookApp.Quit ' End If errorHandler: MsgBox Err.Number & " " & Err.Description 'Clean up Set oItem = Nothing Set oOutlookApp = Nothing End Sub ' SendMsg Public Sub GetWrdDoc() End Sub Public Function FrmDtTm(ByVal time As String, _ ByVal dated As String) End Function Public Function ManipMsg(ByVal name As String, _ ByVal msgBody As Object) ' TODO: FindReplaceName (Find & Replace Default String for Name Field) ' TODO: FindReplaceDtTm (Find & Replace Default String for data & time) End Function Private Function FindReplaceName(ByVal name As String, _ ByVal msgBody As Object) End Function Private Function FindReplaceDtTm(ByVal dated As String, _ ByVal time As String, ByVal msbBody As Object) End Function Public Function fLastRowWithData() Dim excelLastCell Dim LastRowWithData Dim row Set excelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell) ' Determine the last row with data in it(must also copy above para for ' this to work) |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Creating Excel Object in C# | Excel Programming | |||
Creating Excel Object From C# | Excel Discussion (Misc queries) | |||
Creating a picture/object | Excel Discussion (Misc queries) | |||
Creating Com object for excel using vb.net | Excel Programming | |||
Creating a Range object in .Net | Excel Programming |