• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Excel document toevoegen als bijlage aan Lotus Notes email

Status
Niet open voor verdere reacties.
B

bakk

Gebruiker
Lid geworden
7 jan 2008
Berichten
11
Voor mijn werk zoek ik een manier om MSexcel documenten als attachment toe te voegen aan een Lotus Notes e-mail. Dit door middel van een ‘button’ binnen excel.

Helaas krijg ik dit tot op heden nog niet voor elkaar. Ik heb verschillende codes geprobeerd die ik op internet kon vinden, maar allen blijven haken op het connectie maken naar de email client. Het is de bedoeling dat deze macro van elke werkplek af te gebruiken is (het document zal beschikbaar zijn via intranet).

Met de onderstaande code wordt het document opgeslagen, wordt de lotus notes mailbox geopend (het e-mailadres en het onderwerp worden toegevoegd). De bijlage wordt helaas niet toegevoegd aan de email.

Kan iemand mij helpen? Ik heb vrij weinig ervaring met VBA, maar met wat hulp zou dit toch mogelijk moeten zijn.

Alvast bedankt!

Sub SendWithLotus()

' setting up various objects
Dim attachME As Object
Dim EmbedObj1 As Object
Dim recipient As String
Dim ccRecipient As String
Dim bccRecipient As String
Dim subject As String
Dim bodytext As String
Dim Attachment1 As String

Const EMBED_ATTACHMENT As Long = 1454
Const stTitle As String = "Actieve workbook status"
Const stMsg As String = "Het acteive workbook moet eerst worden opgeslagen " & vbCrLf _
& voordat deze als bijlage verstuurd kan worden."

'Check if the active workbook is saved or not
'If the active workbook has not been saved at all.
If Len(ActiveWorkbook.Path) = 0 Then
MsgBox stMsg, vbInformation, stTitle
Exit Sub
End If

'If the changes in the active workbook have been saved or not.
If ActiveWorkbook.Saved = False Then
If MsgBox("Do you want to save the changes before sending?", _
vbYesNo + vbInformation, stTitle) = vbYes Then _
ActiveWorkbook.Save

' setting up all sending recipients
recipient = ThisWorkbook.Worksheets("Voorkant").Range("A2").Value
'ccRecipient = ThisWorkbook.Worksheets("Voorkant").Range("A2").Value + ThisWorkbook.Worksheets("Data").Range("ac1").Value
'bccRecipient = ""
subject = "test 2sdf4"
bodytext = "Please findd Attached Claim File"

'// Lets check to see if form is filled in Min req =Recipient, Subject, Body Text
If recipient = vbNullString Or subject = vbNullString Or bodytext = vbNullString Then
MsgBox "Recipient, Subject and or Body Text is NOT SET!", vbCritical + vbInformation
Exit Sub
End If

Dim sURLto As String

Dim sAddress As String
Dim sSubject As String
Dim sBody As String

sAddress = "mail@mail.nl"
sSubject = "Test mail"
sBody = "body mail?"

sURLto = "mailto:" & sAddress & "?subject=" & sSubject & "&body=" & sBody
ActiveWorkbook.FollowHyperlink Address:=sURLto

Attachment1 = ThisWorkbook.Worksheets("Voorkant").Range("ac1").Value
If Attachment1 <> "" Then
Set attachME = MailDoc.CreateRichTextItem("Attachment1")
Set EmbedObj1 = attachME.EmbedObject(1454, "", Attachment1, "Attachment")
MailDoc.CreateRichTextItem ("Attachment")
End If

'End With

'Activate Excel for the user.
AppActivate "Microsoft Excel"
MsgBox "Het e-mail bericht is succesvol verzonden.", vbInformation

End If

End Sub
Klik om te vergroten...
 
Ellasar zei:
Misschien heb je wat aan onderstaande draad :)

http://www.helpmij.nl/forum/showthread.php?t=237521
Klik om te vergroten...

Bedankt voor je snelle reactie Ellasar.

Het gelinkte draad heb ik al bekenen en de code geprobeerd. Met die code wordt heel de lotus notes 'memo' (nieuwe email) niet geopend. Bij mijn eigen pc heeft Lotus notes wat problemen ivm twee geactiveerde e-mailaccounts. Bij mijn collega werkt deze VBA code ook niet. Waarschijnlijk ligt dit aan de manier van connecten naar de lotus notes database.

Dit is de reden waarvoor ik de manier van connecten naar de lotus notes database in mijn code anders gemaakt heb.
 
bakk,

Niet geheel wat je vraagd, maar als ik een excel bestand open heb op het werk, kan ik dit onmiddelijk in lotes notes als bijlage verzenden via Bestand - Verzenden - E-mail.
Of het mogenlijk is hier een makroknop voor te maken heb ik zelf nog niet uitgeprobeerd.

Albatros
 
Albatros zei:
bakk,

Niet geheel wat je vraagd, maar als ik een excel bestand open heb op het werk, kan ik dit onmiddelijk in lotes notes als bijlage verzenden via Bestand - Verzenden - E-mail.
Of het mogenlijk is hier een makroknop voor te maken heb ik zelf nog niet uitgeprobeerd.

Albatros
Klik om te vergroten...

Helaas is 'verzenden' (of 'send to') niet aanwezig in het bestand (file) menu van excel. Dit is waarschijnlijk omdat msOutlook niet geïnstalleerd is, waardoor Excel deze functie niet aanleverd. Voor zover ik weet is deze functie ook niet aan te zetten.
 
Code: 
Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "C:"
Const stSubject As String = "nieuwe referentie batch"

Const vaMsg As Variant = "Hiebij een nieuwe referentie batch" & vbCrLf & vbCrLf & _
                                          "groeten," & vbCrLf & _
                                           "QC" & vbCrLf & vbCrLf & vbCrLf

Const vaCopyTo As Variant = "" 'copy mailen naar: "adres"
 


Sub Opslaanalswaarden()
    Dim wb As Workbook, ws As Worksheet, MyFile, MyPath
    Dim stFileName As String
    Dim vaRecipients As Variant
    Dim noSession As Object
    Dim noDatabase As Object
    Dim noDocument As Object
    Dim noEmbedObject As Object
    Dim noAttachment As Object
    Dim stAttachment As String
    Dim stEmailAddress As String
    Application.ScreenUpdating = False
    On Error Resume Next
        Set wb = Workbooks.Add
        With Workbooks("qc referentie batches.xls").Sheets("printing")
            
            .Copy Before:=wb.Sheets(1)
            Application.DisplayAlerts = False
            For Each ws In wb.Worksheets
                If ws.Index > 1 Then ws.Delete
            Next
            wb.Sheets(1).Cells.Copy
            wb.Sheets(1).Cells(1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            wb.Sheets(1).Cells(1).Select
            On Error GoTo 0
            With Worksheets("printing")
            Range("A1:I20").Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlValues
            Range("a1").Select
            MyPath = "C:"
            Myname = Range("H6").Value
            MyFile = MyPath & "\" & Myname & ".xls"
            wb.SaveAs Filename:=MyFile
            stFileName = Myname
            stAttachment = stPath & "\" & stFileName & ".xls"
            [COLOR="Red"]stEmailAddress = "DC"[/COLOR]
            vaRecipients = VBA.Array(stEmailAddress)
  
 
  Set noSession = CreateObject("Notes.NotesSession")
  Set noDatabase = noSession.GETDATABASE("", "")
 
 
  If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
 
  
  Set noDocument = noDatabase.CreateDocument
  Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
  Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
 With noDocument
    .Form = "Memo"
    .SendTo = vaRecipients
    .CopyTo = vaCopyTo
    .Subject = stSubject
    .Body = vaMsg
    .SaveMessageOnSend = True
    .PostedDate = Now()
    .Send 0, vaRecipients
  End With
  Set noEmbedObject = Nothing
  Set noAttachment = Nothing
  Set noDocument = Nothing
  Set noDatabase = Nothing
  Set noSession = Nothing
 
  MsgBox "Gegevens zijn verzonden na DC.   ", vbInformation
            wb.Close
            End With
        End With
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    Kill MyFile
End Sub

Dit is de code die ik gebruik. Met het verschil dat ik een vast mail adres gebruik(in het rood) maar als je daar een msgbox plaats is dat ook zo veranderd. Verder maak deze macro een bestandje aan voegt hem toe en verzend hem. na verzenden verwijderd hij het aangemaakte bestand ook weer. kijk maar of dit iets is voor je
 
Relleboer zei:
Code: 
Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "C:"
Const stSubject As String = "nieuwe referentie batch"

Const vaMsg As Variant = "Hiebij een nieuwe referentie batch" & vbCrLf & vbCrLf & _
                                          "groeten," & vbCrLf & _
                                           "QC" & vbCrLf & vbCrLf & vbCrLf

Const vaCopyTo As Variant = "" 'copy mailen naar: "adres"
 


Sub Opslaanalswaarden()
    Dim wb As Workbook, ws As Worksheet, MyFile, MyPath
    Dim stFileName As String
    Dim vaRecipients As Variant
    Dim noSession As Object
    Dim noDatabase As Object
    Dim noDocument As Object
    Dim noEmbedObject As Object
    Dim noAttachment As Object
    Dim stAttachment As String
    Dim stEmailAddress As String
    Application.ScreenUpdating = False
    On Error Resume Next
        Set wb = Workbooks.Add
        With Workbooks("qc referentie batches.xls").Sheets("printing")
            
            .Copy Before:=wb.Sheets(1)
            Application.DisplayAlerts = False
            For Each ws In wb.Worksheets
                If ws.Index > 1 Then ws.Delete
            Next
            wb.Sheets(1).Cells.Copy
            wb.Sheets(1).Cells(1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            wb.Sheets(1).Cells(1).Select
            On Error GoTo 0
            With Worksheets("printing")
            Range("A1:I20").Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlValues
            Range("a1").Select
            MyPath = "C:"
            Myname = Range("H6").Value
            MyFile = MyPath & "\" & Myname & ".xls"
            wb.SaveAs Filename:=MyFile
            stFileName = Myname
            stAttachment = stPath & "\" & stFileName & ".xls"
            [COLOR="Red"]stEmailAddress = "DC"[/COLOR]
            vaRecipients = VBA.Array(stEmailAddress)
  
 
  Set noSession = CreateObject("Notes.NotesSession")
  Set noDatabase = noSession.GETDATABASE("", "")
 
 
  If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
 
  
  Set noDocument = noDatabase.CreateDocument
  Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
  Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
 With noDocument
    .Form = "Memo"
    .SendTo = vaRecipients
    .CopyTo = vaCopyTo
    .Subject = stSubject
    .Body = vaMsg
    .SaveMessageOnSend = True
    .PostedDate = Now()
    .Send 0, vaRecipients
  End With
  Set noEmbedObject = Nothing
  Set noAttachment = Nothing
  Set noDocument = Nothing
  Set noDatabase = Nothing
  Set noSession = Nothing
 
  MsgBox "Gegevens zijn verzonden na DC.   ", vbInformation
            wb.Close
            End With
        End With
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    Kill MyFile
End Sub

Dit is de code die ik gebruik. Met het verschil dat ik een vast mail adres gebruik(in het rood) maar als je daar een msgbox plaats is dat ook zo veranderd. Verder maak deze macro een bestandje aan voegt hem toe en verzend hem. na verzenden verwijderd hij het aangemaakte bestand ook weer. kijk maar of dit iets is voor je
Klik om te vergroten...


De code geprobeerd toe te passen, maar ik krijg de volgende melding:

'runtime error 1004':
Method 'SaveAs' of object '_Workbook' failed
De fout zit hem in de volgende regel: wb.SaveAs Filename:=MyFile

Ik heb trouwens ook het "printing" gedeelte eruit gehaald (deze werkte niet). Wellicht is dit de oorzaak?

Alvast bedankt voor alle hulp
 
bakk zei:
Bedankt voor je snelle reactie Ellasar.

Het gelinkte draad heb ik al bekenen en de code geprobeerd. Met die code wordt heel de lotus notes 'memo' (nieuwe email) niet geopend. Bij mijn eigen pc heeft Lotus notes wat problemen ivm twee geactiveerde e-mailaccounts. Bij mijn collega werkt deze VBA code ook niet. Waarschijnlijk ligt dit aan de manier van connecten naar de lotus notes database.

Dit is de reden waarvoor ik de manier van connecten naar de lotus notes database in mijn code anders gemaakt heb.
Klik om te vergroten...

Dat klopt ten dele, de memo word ineen keer aangemaakt zonder tussenkomst van de (zichtbare) client. hij maakt de memo in VBA aan en verstuurd hem dan rechtstreeks (en zet hem eventueel in je concepten neer)
 
bakk zei:
Helaas is 'verzenden' (of 'send to') niet aanwezig in het bestand (file) menu van excel. Dit is waarschijnlijk omdat msOutlook niet geïnstalleerd is, waardoor Excel deze functie niet aanleverd. Voor zover ik weet is deze functie ook niet aan te zetten.
Klik om te vergroten...

In het 'rechtermuisknop menu' van het bestand (in Windows, op bestand, rechtermuisknop) is de optie 'Send to -> Mail Recipients' wel aanwezig. Deze manier van verzenden pakt Lotus Notes en voegt het bestand idd toe als bijlage.

Wellicht is dit in een VBA macro op te nemen? Iemand een idee?
 
bakk zei:
De code geprobeerd toe te passen, maar ik krijg de volgende melding:

'runtime error 1004':
Method 'SaveAs' of object '_Workbook' failed
De fout zit hem in de volgende regel: wb.SaveAs Filename:=MyFile

Ik heb trouwens ook het "printing" gedeelte eruit gehaald (deze werkte niet). Wellicht is dit de oorzaak?

Alvast bedankt voor alle hulp
Klik om te vergroten...

Printing was een naam van een werkblad bij mij. maar heb je ook niks aan de methode van toevoegen van bijlagen
 
Relleboer zei:
Printing was een naam van een werkblad bij mij. maar heb je ook niks aan de methode van toevoegen van bijlagen
Klik om te vergroten...

Ah, ik zie het nu idd. Ik heb wat in de code veranderd, zodat het opgeslagen bestand altijd dezelfde naam zal hebben;
ipv MyFile = MyPath & "\" & Myname & ".xls" -> MyFile = MyPath & "\" & "Myfile.xls".

Hij slaat het bestand nu in ieder geval op. Ik kan nog niet testen of de e-mail, incl bijlage wordt opgemaakt. Wanneer ik dit heb kunnen doen, zal ik dit hier plaatsen.
 
CODE][Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "C:"
Const stSubject As String = "nieuwe referentie batch"

Const vaMsg As Variant = "Hiebij een nieuwe referentie batch" & vbCrLf & vbCrLf & _
"groeten," & vbCrLf & _
"QC" & vbCrLf & vbCrLf & vbCrLf

Const vaCopyTo As Variant = "" 'copy mailen naar: "adres"



Sub Opslaanalswaarden()
Dim wb As Workbook, ws As Worksheet, MyFile, MyPath
Dim stFileName As String
Dim vaRecipients As Variant
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String
Dim stEmailAddress As String
Application.ScreenUpdating = False
On Error Resume Next Set wb = Workbooks.Add
With Workbooks("qc referentie batches.xls").Sheets("printing")

.Copy Before:=wb.Sheets(1)
Application.DisplayAlerts = False
For Each ws In wb.Worksheets
If ws.Index > 1 Then ws.Delete
Next
wb.Sheets(1).Cells.Copy
wb.Sheets(1).Cells(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
wb.Sheets(1).Cells(1).Select
On Error GoTo 0
With Worksheets("printing")
Range("A1:I20").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Range("a1").Select
MyPath = "C:"
Myname = Range("H6").Value
MyFile = MyPath & "\" & Myname & ".xls"
wb.SaveAs Filename:=MyFile
stFileName = Myname
stAttachment = stPath & "\" & stFileName & ".xls"
stEmailAddress = "DC"
vaRecipients = VBA.Array(stEmailAddress)


Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")


If noDatabase.IsOpen = False Then noDatabase.OPENMAIL


Set noDocument = noDatabase.CreateDocument
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.CopyTo = vaCopyTo
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, vaRecipients
End With
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing

MsgBox "Gegevens zijn verzonden na DC. ", vbInformation
wb.Close
End With
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Kill MyFile
End Sub [/CODE]

Het gaat om het blauwe stuk. de tussen liggende bewerking zul je toch na eigen wens moeten invullen
 
Helaas, ik krijg de code niet helemaal werkend; ik krijg namelijk de volgende melding:

Run-time error '7063':
Database ....................... has not been opened yet.

(Lotus Notes staat gewoon aan)

Enig idee?
 
Geen idee. als ik hem los heb staan gebruikt hij hem en anders opend hij hem eerst maar zonder fout melding
 
Inmiddels heb ik eindelijk een oplossing gevonden voor het bijvoegen van een attachment aan een e-mail.

Door middel van het volgende stukje code kan dit:

ActiveWorkbook.SendforReview ShowMessage:=True
Klik om te vergroten...

Nu heb ik dit stukje code proberen samen te voegen met een ander stuk, wat ervoor moet zorgen dat het e-mail adres van de ontvanger automatisch ingevuld dient te worden. De code ziet er als volgt uit:

Sub Macro1()
' Macro1 Macro

Dim sURLto As String
Dim sAddress As String

sAddress = "Mail@Mail.com"

sURLto = "mailto:" & sAddress
ActiveWorkbook.FollowHyperlink Address:=sURLto

ActiveWorkbook.SendforReview ShowMessage:=True

End Sub
Klik om te vergroten...

Het probleem is nu, dat Lotus Notes 2x een nieuwe memo aanmaakt; 1 memo met de bijlage en zonder e-mail adres van de ontvanger en 1 memo met het e-mail adres van de ontvanger, maar zonder de attachment.

Ik denk dat de code dus op één of andere manier aan elkaar gekoppeld moet worden. Ik weet alleen niet hoe.. Iemand die me hierbij kan helpen? Ik ben er bijna, alleen de laatste stap heb ik wat hulp bij nodig.

Alvast bedankt!
 
Hallo,

Ik ben momenteel ook bezig met het versturen van overzichten via excel en lotus notes naar afdelingsmanagers.
Nu heb ik een klein voorbeeldje gemaakt. (zie bijlagen)
Het probleem is nu dat de macro alleen werkt per tabblad. Ik zou graag willen dat met 1 druk op de knop alle tabbladen worden gestuurd naar de mensen.
Tevens komt het ook voor dat sommige managers meerdere afdelingsoverzichten ontvangen. Daarom wil ik graag dat ze dit in 1 bestand krijgen met hierin dus enkele tabbladen.

Wie zou me hier mee kunnen helpen?

Groeten
DenniBekijk bijlage Testafdelingsoverzicht.xls
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan