Liebe Leute,
mein erster Post hier und gleich eine eher dumme Frage. (meine Version is 2007)
Ich bin dabei zu versuchen, aus einer Personendatenbank Massen-EMailing via Outlook zu erstellen. Als VBA-Nichtkönner habe ich zunächst gegooglet und dabei ein wunderbares Beispiel gefunden, dass auch in Access 2007 funktioniert: das Access Archon Nr. 106 (http://www.helenfeddema.com/access.htm).
Runtergeladen, entpackt, Beispieldatenbank in A07 geöffnet und es funktioniert perfekt.
Nun habe ich versucht, das Ganze auf meine eigene Datenbank zu übertragen. -
- Eine der Beispieldatenbank analoge Abfrage (allerdings mit 4 statt 2 Spalten) erstellt, die resultierende Tabelle enthält die Daten, die ich benötige.
- Das Beispielformular kopiert (also aus der Entuwrfsansicht die Datenbankfelder in ein neues Formular in meiner eigenen DB kopiert + den VBA Code hinterlegt).
- Versucht, das Ganze auch nur in der Formularansicht aufzurufen, funktioniert nicht:
Ich bekomme die Fehlermeldung: BeiLaden - Benutzerdefinierter Typ nicht definiert.
Schön und gut, den entsprechenden VBA Code (s.u.) also erstmal kommentiert und weitergemacht. Es scheint aber so, als wenn jede Private Sub diesen Fehler hervorruft.
Option Compare Database
Option Explicit
Dim appOutlook As New Outlook.Application
Dim lngCount As Long
Dim lngListCount As Long
Dim lst As Access.ListBox
Dim msg As Outlook.MailItem
Dim strBody As String
Dim strEMailRecipient
Dim strSubject As String
Dim strTo As String
Dim varItem As Variant
Private Sub cmdClose_Click()
On Error GoTo cmdClose_ClickError
DoCmd.Close acForm, Me.Name
cmdClose_ClickExit:
Exit Sub
cmdClose_ClickError:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume cmdClose_ClickExit
End Sub
Private Sub cmdDeselectAll_Click()
'Created by Helen Feddema 7-7-2002
'Last modified 7-7-2002
On Error GoTo ErrorHandler
Set lst = Me![lstSelectContacts]
lngListCount = Me![lstSelectContacts].ListCount
For lngCount = 0 To lngListCount
lst.Selected(lngCount) = False
Next lngCount
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub cmdMergetoEMailMulti_Click()
'Created by Helen Feddema 6-30-2002
'Last modified 7-7-2002
On Error GoTo ErrorHandler
Set lst = Me![lstSelectContacts]
'Check that at least one contact has been selected
If lst.ItemsSelected.Count = 0 Then
MsgBox "Please select at least one contact"
lst.SetFocus
GoTo ErrorHandlerExit
End If
'Test for required fields
strSubject = Me![txtSubject].Value
If strSubject = "" Then
MsgBox "Please enter a subject"
Me![txtSubject].SetFocus
GoTo ErrorHandlerExit
End If
strBody = Me![txtBody].Value
If strBody = "" Then
MsgBox "Please enter a message body"
Me![txtBody].SetFocus
GoTo ErrorHandlerExit
End If
For Each varItem In lst.ItemsSelected
'Check for email address
strEMailRecipient = Nz(lst.Column(1, varItem))
Debug.Print "EMail address: " & strEMailRecipient
If strEMailRecipient = "" Then
GoTo NextContact
End If
'Create new mail message and send to contact
Set msg = appOutlook.CreateItem(olMailItem)
With msg
.To = strEMailRecipient
.Subject = strSubject
.Body = strBody
.Display
End With
NextContact:
Next varItem
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub cmdMergeToEMailSingle_Click()
'Created by Helen Feddema 6-30-2002
'Last modified 6-30-2002
On Error GoTo ErrorHandler
Dim strBCC As String
Set lst = Me![lstSelectContacts]
'Check that at least one contact has been selected
If lst.ItemsSelected.Count = 0 Then
MsgBox "Please select at least one contact"
lst.SetFocus
GoTo ErrorHandlerExit
End If
'Test for required fields
strTo = Me![txtTo].Value
If strTo = "" Then
strTo = "someone@microsoft.com"
End If
strSubject = Me![txtSubject].Value
If strSubject = "" Then
MsgBox "Please enter a subject"
Me![txtSubject].SetFocus
GoTo ErrorHandlerExit
End If
strBody = Me![txtBody].Value
If strBody = "" Then
MsgBox "Please enter a message body"
Me![txtBody].SetFocus
GoTo ErrorHandlerExit
End If
'Add contacts to variable for BCC field
For Each varItem In lst.ItemsSelected
'Check for email address
strEMailRecipient = Nz(lst.Column(1, varItem))
Debug.Print "EMail address: " & strEMailRecipient
If strEMailRecipient <> "" Then
strBCC = strBCC & strEMailRecipient & ";"
End If
Next varItem
strBCC = Left(strBCC, Len(strBCC) - 1)
'Create new mail message and send to contacts
Set msg = appOutlook.CreateItem(olMailItem)
With msg
.To = strTo
.Subject = strSubject
.Body = strBody
.BCC = strBCC
.Display
End With
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub cmdSelectAll_Click()
'Created by Helen Feddema 7-7-2002
'Last modified 7-7-2002
On Error GoTo ErrorHandler
Set lst = Me![lstSelectContacts]
lngListCount = Me![lstSelectContacts].ListCount
For lngCount = 0 To lngListCount
lst.Selected(lngCount) = True
Next lngCount
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub Form_Load()
'Created by Helen Feddema 6-30-2002
'Last modified 7-7-2002
On Error GoTo ErrorHandler
DoCmd.Restore
DoCmd.RunCommand acCmdSizeToFitForm
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub Form_Open(Cancel As Integer)
'Created by Helen Feddema 6-30-2002
'Last modified 7-7-2002
On Error GoTo ErrorHandler
Me![txtSubject].Value = "Message subject"
Me![txtBody].Value = "Body of message"
Me![txtTo].Value = "someone@microsoft.com"
Set lst = Me![lstSelectContacts]
lngCount = lst.ListCount
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Insbesondere geht es um diesen Code:
Private Sub Form_Open(Cancel As Integer)
'Created by Helen Feddema 6-30-2002
'Last modified 7-7-2002
On Error GoTo ErrorHandler
Me![txtSubject].Value = "Message subject"
Me![txtBody].Value = "Body of message"
Me![txtTo].Value = "someone@microsoft.com"
Set lst = Me![lstSelectContacts]
lngCount = lst.ListCount
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Ich gehe davon aus, dass es in der Beispieldatenbank Definitionen der benutzerdefinierten Befehle gibt. Allerdings weiß ich um keine Möglichkeit, an diese heranzukommen.
Ich weiß, diese Frage ist dumm, aber woran hakt es hier?
Besten Dank für jedwede Hilfe!
Hallo,
siehe auch: ???
http://www.office-loesung.de/ftopic428361_0_0_asc.php (http://www.office-loesung.de/ftopic428361_0_0_asc.php)
Sorry. Brauchte schnelle Hilfe, da bleibt Crossposting manchmal nicht aus. Soll nicht wieder vorkommen.
Die Lösung: Einbinden der Microsoft Outlook 12.0 Object Library.
Danke!