Re: 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").Select

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" <DigitSolver@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:965FF69E-3503-4DDC-A526-11538EBB217A@xxxxxxxxxxxxxxxx
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 spread*** 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 = "recipient2@xxxxxxxx"
'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 = Active***.Cells.SpecialCells(xlLastCell)

' Determine the last row with data in it(must also copy above para
for
' this to work)
.

Loading