Sheet mit Lotus Notes versenden mit Kopie an:

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

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

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

Beliebteste Forumthreads (12 Monate)

Sheet mit Lotus Notes versenden mit Kopie an:

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

132 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Sheet mit Lotus Notes versenden mit Kopie an:

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

132 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread