On Thu, 9 Jan 2003 10:06:45 +0100, "Kim Rex Bengtsson"
<KB@braedstrup.dk> wrote:
>Hej
>
>Er det muligt at få adgang til kontakt person vba i word.
>
>Det jeg gerne ville er at man henter alle firma ind fra kontaktpersoner og
>putter dem i en listbox. Når man så vælger et firma skal man kunne trække
>alle de andre oplysninger ind i et word dokument. navn, adresse etc.
Understående funktion benytter jeg i en Access-database, men det kunne
ligeså vel bruges i Word. Koden åbner indbakke, scanner for evt.
vedhæftede filer som gemmes, og sletter efterfølgende mailen.
Øverst i funktionen er angivet mappernes referencer..herunder
kontaktpersoner. Tænker det kan bruges:
'---code begin
Function HandleOutlook() As Boolean
'FolderTypeEnum, kan være følgende:
'olFolderCalendar(9),
'olFolderContacts(10),
'olFolderDeletedItems(3),
'olFolderDrafts(16),
'olFolderInbox(6),
'olFolderJournal(11),
'olFolderNotes(12),
'olFolderOutbox(4),
'olFolderSentMail(5),
'olFolderTasks (13)
Dim objOL As Object
Dim objNS As Object
Dim objFolder As Object
Dim objAllItems As Object
Dim objItem As Object
Dim objAllAttachments As Object
Dim objAttachment As Object
Dim cPath As String
Dim cFolderName As String
Dim cMsg As String
Dim RetVal
Dim nCount As Integer
Dim nItems As Integer
Dim i As Integer
nCount = 0
Set objOL = CreateObject("Outlook.Application")
If Err Then
MsgBox "Kunne ikke oprette Outlook Application object (check
referencer) !", vbCritical
HandleOutlook = False
Exit Function
End If
Set objNS = objOL.GetNamespace("MAPI")
If Err Then
MsgBox "Kunne ikke oprette MAPI Namespace !", vbCritical
HandleOutlook = False
Exit Function
End If
Set objFolder = objNS.GetDefaultFolder(6)
If Err Then
MsgBox "Outlook-mappen (Inbox) kunne ikke findes!", vbCritical
HandleOutlook = False
Exit Function
End If
Set objAllItems = objFolder.Items
nItems = objFolder.Items.Count
cFolderName = objNS.GetDefaultFolder(6)
cPath = "U:\Import\"
For Each objItem In objAllItems
Set objAllAttachments = objItem.Attachments
For Each objAttachment In objAllAttachments
objAttachment.SaveAsFile cPath & objAttachment.DisplayName
nCount = nCount + 1
Next
Next
'Pas på understående i testmiljø...sletter fra indbakken !!
'For I = nItems To 1 Step -1
'objAllItems(I).Delete
'Next
nCount = 0
Set objFolder = objNS.GetDefaultFolder(3)
Set objAllItems = objFolder.Items
'for i
HandleOutlook = True
End Function
'---code end
mvh /Snedker
---
Klip det citerede væk, du ikke besvarer
Besvar venligst under det citerede
|