Sheet mit Lotus Notes versenden mit Kopie an:

Beitrag aus dem Excel-Forumsarchiv

Home

Zur Übersicht

Thema: Sheet mit Lotus Notes versenden mit Kopie an:

Sheet mit Lotus Notes versenden mit Kopie an: von Klaus M. vom 09.03.2010 21:26:37

AW: Sheet mit Lotus Notes versenden mit Kopie an: - von Josef Ehrensberger am 10.03.2010 01:11:35
- AW: Sheet mit Lotus Notes versenden mit Kopie an: - von Klaus M. am 10.03.2010 01:32:27
  - AW: Sheet mit Lotus Notes versenden mit Kopie an: - von Josef Ehrensberger am 10.03.2010 01:38:33
    - AW: Sheet mit Lotus Notes versenden mit Kopie an: - von Klaus M. am 10.03.2010 02:00:53
      - AW: Sheet mit Lotus Notes versenden mit Kopie an: - von Josef Ehrensberger am 10.03.2010 09:08:47

Betrifft: Sheet mit Lotus Notes versenden mit Kopie an:
von: Klaus M.
Geschrieben am: 09.03.2010 21:26:37

Hallo Excelprofis,
habe den gleichen Betrag schon letzte Woche eingestellt, leider bin ich nicht weiter gekommen.
Vielen dank erst mal an mumpel, aber die Makros habe nicht funktioniert. Kannst du oder jemand anders mir mal zur Hand gehen?
Ich möchte eien Mail versenden mit mehr als 10 Empfängern und wollte die anderen in Kopie anschreiben, denn bei 10 Empfängern ist Schluss und das Makro bleibt stehen.
Hier mein Makro: sKopie geht nicht!!!!!
Danke im voraus.

Sub KapaMailenCKSZ2()
Sheets("Sofo").Select

'Blattschutz deaktivieren


'Blatt für Fax

ActiveSheet.Shapes("Drop1").Visible = False
ActiveSheet.Shapes("Drop2").Visible = False
ActiveSheet.Shapes("Drop3").Visible = False
ActiveSheet.Shapes("Drop4").Visible = False
ActiveSheet.Shapes("Drop5").Visible = False
ActiveSheet.Shapes("Drop6").Visible = False
ActiveSheet.Shapes("Drop7").Visible = False
ActiveSheet.Shapes("Drop8").Visible = False
ActiveSheet.Shapes("Drop9").Visible = False
ActiveSheet.Shapes("Drop10").Visible = False
ActiveSheet.Shapes("Drop11").Visible = False
ActiveSheet.Shapes("Mail").Visible = False

Columns("AH:BZ").Select
Selection.EntireColumn.Hidden = True
Rows("68:110").Select
Range("A110").Activate
Selection.EntireRow.Hidden = True
Range("AL21").Select

ActiveSheet.Copy
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial xlValues
Range("L13").Select

'Mail-Adressen

ActiveWorkbook.SendMail Range("AI63") & Range("AI66")
sKopie = "L.RSC#B9596123199@fax,H.F.#B93304042588@fax,L#B959650404404@fax"
'ActiveWorkbook.SendMail "     @internet", "Verständigung"
'ActiveWorkbook.SendMail "     @internet", "Verständigung"
'ActiveWorkbook.SendMail "     @internet", "Verständigung"
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False

'Blatt für Fax - zurück

Columns("AH:BZ").Select
Selection.EntireColumn.Hidden = False
Rows("68:110").Select
Range("A110").Activate
Selection.EntireRow.Hidden = False

ActiveSheet.Shapes("Drop1").Visible = True
ActiveSheet.Shapes("Drop2").Visible = True
ActiveSheet.Shapes("Drop3").Visible = True
ActiveSheet.Shapes("Drop4").Visible = True
ActiveSheet.Shapes("Drop5").Visible = True
ActiveSheet.Shapes("Drop6").Visible = True
ActiveSheet.Shapes("Drop7").Visible = True
ActiveSheet.Shapes("Drop8").Visible = True
ActiveSheet.Shapes("Drop9").Visible = True
ActiveSheet.Shapes("Drop10").Visible = True
ActiveSheet.Shapes("Drop11").Visible = True
ActiveSheet.Shapes("Mail").Visible = True


Range("AL21").Select

End Sub

Betrifft: AW: Sheet mit Lotus Notes versenden mit Kopie an:
von: Josef Ehrensberger
Geschrieben am: 10.03.2010 01:11:35

Hallo Klaus,

in ermangelung (gottlob) von Lotus Notes, vollkommen ungetestet.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub KapaMailenCKSZ2()
  Dim strFile As String, strTO As String, strCC As String, strBody As String, strSubject As String

  On Error GoTo ErrExit

  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With

  strFile = Environ("TEMP") & "TEMP_" & ThisWorkbook.Name

  strTO = Range("AI63") & ";" & Range("AI66") 'Empfänger getrennt durch ;

  strCC = "L.RSC#B9596123199@fax;H.F.#B93304042588@fax;L#B959650404404@fax" 'CC getrennt durch ;

  strBody = "Nachrichtentext" 'Text

  strSubject = "Betreff" 'Betreff

  With Sheets("Sofo")

    'Blattschutz deaktivieren


    'Blatt für Fax

    .Shapes("Drop1").Visible = False
    .Shapes("Drop2").Visible = False
    .Shapes("Drop3").Visible = False
    .Shapes("Drop4").Visible = False
    .Shapes("Drop5").Visible = False
    .Shapes("Drop6").Visible = False
    .Shapes("Drop7").Visible = False
    .Shapes("Drop8").Visible = False
    .Shapes("Drop9").Visible = False
    .Shapes("Drop10").Visible = False
    .Shapes("Drop11").Visible = False
    .Shapes("Mail").Visible = False

    .Columns("AH:BZ").EntireColumn.Hidden = True
    .Rows("68:110").EntireRow.Hidden = True

    .Copy

    ActiveSheet.Cells.Copy
    ActiveSheet.Cells.PasteSpecial xlValues
    ActiveWorkbook.SaveAs strFile
    ActiveWorkbook.Close

    SendMail_With_LotusNotes strBody, strSubject, strTO, strCC, , strFile

    'Blatt für Fax - zurück

    .Columns("AH:BZ").EntireColumn.Hidden = False
    .Rows("68:110").EntireRow.Hidden = False

    .Shapes("Drop1").Visible = True
    .Shapes("Drop2").Visible = True
    .Shapes("Drop3").Visible = True
    .Shapes("Drop4").Visible = True
    .Shapes("Drop5").Visible = True
    .Shapes("Drop6").Visible = True
    .Shapes("Drop7").Visible = True
    .Shapes("Drop8").Visible = True
    .Shapes("Drop9").Visible = True
    .Shapes("Drop10").Visible = True
    .Shapes("Drop11").Visible = True
    .Shapes("Mail").Visible = True
  End With

  Kill strFile

  ErrExit:

  With Err
    If .Number <> 0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & _
      .Description & vbLf & vbLf & "In Prozedur (KapaMailenCKSZ2) in Modul Modul1", _
      vbExclamation, "Fehler in Modul1 / KapaMailenCKSZ2"
  End With

  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
  End With

End Sub

Sub SendMail_With_LotusNotes(Body As String, Subject As String, sendTo As String, Optional sendToCC _
    As String, Optional sendToBC As String, Optional FileToSend As String)

  Dim objSession As Object, objDB As Object, objDocument As Object
  Dim objRTItem As Object, objAttachment As Object, objFile As Object
  Dim strUser As String, strServer As String, strFile As String
  Dim strTO() As String, strCC() As String, strBC() As String

  On Error GoTo ErrExit

  strTO = Split(sendTo, ";")

  If Len(sendToCC) Then strCC = Split(sendToCC, ";")
  If Len(sendToBC) Then strBC = Split(sendToBC, ";")

  Set objSession = CreateObject("notes.notessession")

  strUser = objSession.UserName
  strServer = objSession.GetEnvironmentString("MailServer", True)

  strFile = objSession.GetEnvironmentString("strFile", True)

  Set objDB = objSession.getdatabase(strServer, strFile)

  Set objDocument = objDB.createdocument()

  objDocument.Form = "Memo"

  objDocument.sendTo = strTO

  If Len(sendToCC) > 0 Then objDocument.CopyTo = strCC
  If Len(sendToBC) > 0 Then objDocument.BlindcopyTo = strBC

  objDocument.Subject = Subject

  Set objRTItem = objDocument.CREATERICHTEXTITEM("body")

  Call objRTItem.APPENDTEXT(Body)

  objDocument.SAVEMESSAGEONSEND = True
  objDocument.PostedDate = Now

  If FileToSend <> "" Then
    Set objAttachment = objDocument.CREATERICHTEXTITEM("Attachment")
    Set objFile = objAttachment.EMBEDOBJECT(1454, "", FileToSend, "Attachment")
  End If

  Call objDocument.Send(False)

  ErrExit:
  With Err
    If .Number <> 0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & _
      IIf(Erl > 0, "In Zeile " & Erl & vbLf & vbLf, "") & _
      .Description & vbLf & vbLf & "In Prozedur (SendMail_With_LotusNotes) in Modul Modul1", _
      vbExclamation, "Fehler in Modul1 / SendMail_With_LotusNotes"
  End With

  Set objRTItem = Nothing
  Set objAttachment = Nothing
  Set objFile = Nothing
  Set objDB = Nothing
  Set objDocument = Nothing
  Set objSession = Nothing
End Sub

Gruß Sepp

Betrifft: AW: Sheet mit Lotus Notes versenden mit Kopie an:
von: Klaus M.
Geschrieben am: 10.03.2010 01:32:27

Guten Abend Josef,
das makro läuft durch bis siehe unten, es wird aber leider nix verschickt.
ErrExit:
End With

Betrifft: AW: Sheet mit Lotus Notes versenden mit Kopie an:
von: Josef Ehrensberger
Geschrieben am: 10.03.2010 01:38:33

Hallo Klaus,

nimm den folgenden Code, ich hab noch einen Fehler entdeckt.

Erscheint eine Fehlermeldung? Wenn ja, wie lautet sie?

Die Datei muss gespeichert sein, also nicht in einer ungespeicherten Mappe testen.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub KapaMailenCKSZ2()
  Dim strFile As String, strTO As String, strCC As String, strBody As String, strSubject As String

  On Error GoTo ErrExit

  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With

  With Sheets("Sofo")

    strFile = Environ("TEMP") & "TEMP_" & ThisWorkbook.Name

    strTO = .Range("AI63") & ";" & .Range("AI66") 'Empfänger getrennt durch ;

    strCC = "L.RSC#B9596123199@fax;H.F.#B93304042588@fax;L#B959650404404@fax" 'CC getrennt durch ;

    strBody = "Nachrichtentext" 'Text

    strSubject = "Betreff" 'Betreff

    'Blattschutz deaktivieren


    'Blatt für Fax

    .Shapes("Drop1").Visible = False
    .Shapes("Drop2").Visible = False
    .Shapes("Drop3").Visible = False
    .Shapes("Drop4").Visible = False
    .Shapes("Drop5").Visible = False
    .Shapes("Drop6").Visible = False
    .Shapes("Drop7").Visible = False
    .Shapes("Drop8").Visible = False
    .Shapes("Drop9").Visible = False
    .Shapes("Drop10").Visible = False
    .Shapes("Drop11").Visible = False
    .Shapes("Mail").Visible = False

    .Columns("AH:BZ").EntireColumn.Hidden = True
    .Rows("68:110").EntireRow.Hidden = True

    .Copy

    ActiveSheet.Cells.Copy
    ActiveSheet.Cells.PasteSpecial xlValues
    ActiveWorkbook.SaveAs strFile
    ActiveWorkbook.Close

    SendMail_With_LotusNotes strBody, strSubject, strTO, strCC, , strFile

    'Blatt für Fax - zurück

    .Columns("AH:BZ").EntireColumn.Hidden = False
    .Rows("68:110").EntireRow.Hidden = False

    .Shapes("Drop1").Visible = True
    .Shapes("Drop2").Visible = True
    .Shapes("Drop3").Visible = True
    .Shapes("Drop4").Visible = True
    .Shapes("Drop5").Visible = True
    .Shapes("Drop6").Visible = True
    .Shapes("Drop7").Visible = True
    .Shapes("Drop8").Visible = True
    .Shapes("Drop9").Visible = True
    .Shapes("Drop10").Visible = True
    .Shapes("Drop11").Visible = True
    .Shapes("Mail").Visible = True
  End With

  Kill strFile

  ErrExit:

  With Err
    If .Number <> 0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & _
      .Description & vbLf & vbLf & "In Prozedur (KapaMailenCKSZ2) in Modul Modul1", _
      vbExclamation, "Fehler in Modul1 / KapaMailenCKSZ2"
  End With

  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
  End With

End Sub

Sub SendMail_With_LotusNotes(Body As String, Subject As String, sendTo As String, Optional sendToCC _
    As String, Optional sendToBC As String, Optional FileToSend As String)

  Dim objSession As Object, objDB As Object, objDocument As Object
  Dim objRTItem As Object, objAttachment As Object, objFile As Object
  Dim strUser As String, strServer As String, strFile As String
  Dim strTO() As String, strCC() As String, strBC() As String

  On Error GoTo ErrExit

  strTO = Split(sendTo, ";")

  If Len(sendToCC) Then strCC = Split(sendToCC, ";")
  If Len(sendToBC) Then strBC = Split(sendToBC, ";")

  Set objSession = CreateObject("notes.notessession")

  strUser = objSession.UserName
  strServer = objSession.GetEnvironmentString("MailServer", True)

  strFile = objSession.GetEnvironmentString("strFile", True)

  Set objDB = objSession.getdatabase(strServer, strFile)

  Set objDocument = objDB.createdocument()

  objDocument.Form = "Memo"

  objDocument.sendTo = strTO

  If Len(sendToCC) > 0 Then objDocument.CopyTo = strCC
  If Len(sendToBC) > 0 Then objDocument.BlindcopyTo = strBC

  objDocument.Subject = Subject

  Set objRTItem = objDocument.CREATERICHTEXTITEM("body")

  Call objRTItem.APPENDTEXT(Body)

  objDocument.SAVEMESSAGEONSEND = True
  objDocument.PostedDate = Now

  If FileToSend <> "" Then
    Set objAttachment = objDocument.CREATERICHTEXTITEM("Attachment")
    Set objFile = objAttachment.EMBEDOBJECT(1454, "", FileToSend, "Attachment")
  End If

  Call objDocument.Send(False)

  ErrExit:
  With Err
    If .Number <> 0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & _
      IIf(Erl > 0, "In Zeile " & Erl & vbLf & vbLf, "") & _
      .Description & vbLf & vbLf & "In Prozedur (SendMail_With_LotusNotes) in Modul Modul1", _
      vbExclamation, "Fehler in Modul1 / SendMail_With_LotusNotes"
  End With

  Set objRTItem = Nothing
  Set objAttachment = Nothing
  Set objFile = Nothing
  Set objDB = Nothing
  Set objDocument = Nothing
  Set objSession = Nothing
End Sub

Gruß Sepp

Betrifft: AW: Sheet mit Lotus Notes versenden mit Kopie an:
von: Klaus M.
Geschrieben am: 10.03.2010 02:00:53

Hallo Josef,

ich bekomme die Fehlermeldung 7063
Database CN = BLNSRl/6050/0=CB AG/C=DE has not been opend yet
In Prozedur (SendMail_With_LotusNotes) in Modul Modul1
Ich hoffe du kannst was damit anfangen, ich leider nicht.
Gruß Klaus

Betrifft: AW: Sheet mit Lotus Notes versenden mit Kopie an:
von: Josef Ehrensberger
Geschrieben am: 10.03.2010 09:08:47

Hallo Klaus,

nein, die Fehlermeldung sagt mir nichts, ich hab Notes nicht, deshalb kann ich dir nicht weiterhelfen.

Gruß Sepp