AW: Archivierung nicht möglich
24.11.2011 08:06:43
fcs
Hallo slopor,
ich habe/verwende Outlook nicht als e-mail-Programm. Kann also nicht alles Testen.
Soweit ich feststellen konnte hängt das Problem auch hier mit dem Blattschutz zusammen.
Während der Makroausführung darf das Blatt "open_items" für bestimmte Funktionen nicht geschützt sein.
Mit folgenden Anpassungen für den Code der Schaltfläche "Email" sollte es funktionieren.
Zusätzlich muss du für die Spalten I und K noch die bedingten Formatierungen anpassen/ergänzen.
Gruß
Franz
Private Sub CommandButton3_Click()
Dim MyRange As Range, ToEmail As String
'compile the required range (Header row + data row, only first row of data row is taken
'in case multiple rows are selected)
Me.Unprotect
Set MyRange = Range("A5:K5," & Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 11)). _
Address)
Debug.Print MyRange.Address
Debug.Print ActiveCell.Address
'check if selected row contains data
If WorksheetFunction.CountA(Range(Cells(ActiveCell.Row, 3), Cells(ActiveCell.Row, 11))) = 0 _
Then
MsgBox "Selected row is empty. Abort", 16, "No data found!!"
GoTo Beenden
End If
ToEmail = Cells(ActiveCell.Row, 11).Value
Call Mail_Range_Outlook_Body(MyRange, ToEmail)
If UserSel = "" Then
MsgBox "Email was sent to: " & ToEmail, 64, "Finish"
End If
UserSel = ""
Beenden:
Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
End Sub