Excel: Code für Versenden einer Mail?

Hallo Community, wie kann ich es hinbekommen, dass die Dateinicht nur in den Postausgang gelegt wird sondern auch versendet wird? hier mein Code:

    Sub ExcelDateiSendenMitText()
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
'Aktive Arbeitsmappe wird als Mail gesendet
AWS = ThisWorkbook.FullName
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "xxxx@xxx.com; xxxxx@xxx.de"
.Subject = Range("F1") & Date & Time
.attachments.Add AWS
.Body = "text blabla"
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'Mail.Send
End With
'Outlook schliessen
'OutApp.Quit
Set OutApp = Nothing
Set Nachricht = Nothing
End Sub

Ich weiß nicht weiter bitte um hilfe

Danke schon mal im Voraus

4 Antworten

pauli995

05.07.2016, 08:56

habe es so lösen können:

Sub Mappe_versenden_als_EMail()

Dim objOL As Object

Dim objMail As Object

Dim Bezeichnung As String

Dim MAdr As String

Set objOL = CreateObject("Outlook.Application")

Set objMail = objOL.CreateItem(0)

Bezeichnung = ActiveWorkbook.Name

MAdr = "name@xxx.com" 'Deine E-Mail Adresse

Application.ScreenUpdating = False

With objMail

.To = MAdr

.Subject = Range("F1") & Date & Time

.Body = "text"

.attachments.Add ActiveWorkbook.FullName

.Send

End wthi

MsgBox ("..")

Application.ScreenUpdating = True

End Sub

sternstefan

28.06.2016, 14:34

Bei

'Mail.Send

das Hochkomma entfernen und in "Nachricht.Send" umbenennen.

verreisterNutzer

28.06.2016, 12:10

Hallo,

Mail.Send ist doch auskommentiert -- dass sie über haupt in den "Senden-Ordner gelegt wird ??

pauli995

Fragesteller

28.06.2016, 12:23

die mail wird aber nicht versendet sondern nur in postausgang gelegt von
dem outlook account aus in dem ich angemeldet bin aber die empfänger
bekommen die nachricht nicht. die mail wird als noch nicht gesendet im
eigenen postausgang gespeichert. also asugeführt wird alles außer dass
die empfänger die mail erhalten

Suboptimierer

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

28.06.2016, 12:03

Welchen Fehler bekommst du denn bei Mail.Send (in deinem Fall Nachricht.Send)?

Woher ich das weiß:Studium / Ausbildung – Fachinformatiker - Anwendungsentwicklung

pauli995

Fragesteller

28.06.2016, 12:22

die mail wird aber nicht versendet sondern nur in postausgang gelegt von dem outlook account aus in dem ich angemeldet bin aber die empfänger bekommen die nachricht nicht. die mail wird als noch nicht gesendet im eigenen postausgang gespeichert. also asugeführt wird alles außer dass die empfänger die mail erhalten

pauli995

Fragesteller

28.06.2016, 12:24

@pauli995

Den Code habe ich mir mit meinem wenigen Wissen und aus Ideen aus Foren zusammengebastelt, da ich mich nicht gut genug auskenne. daher finde ich den fehler nciht

Suboptimierer

29.06.2016, 09:38

@pauli995

Hmm, das könnte eine Einstellung im Outlook sein. Leider nutze ich kein Outlook, sodass ich dir keine Lösung erarbeiten kann.

Hallo, ich würde gerne eine Rechnung mit einem Makro erstellen. Soweit klappt das auch und die Mail öffnet sich auch, aber diese wird nicht als Anhang hinzugefügt. Ich komme leider nicht drauf. Ich denke, es liegt daran, dass er die Datei nicht findet, aber ich wüsste keinen Lösungsansatz. Hier der Code:

Dim Result As VbMsgBoxResult

Sub RechnungsnrUndDrucken()

Sheets("Rechnung_Video").Select

[D15] = [D15] + 1 'Rechnungsnummer 1 hochzählen

Dim sCC As String

Dim sName As String

Dim sText As String

Dim sObject As String

Dim sCompany As String

Dim sRefNr As String

Dim sTempFileName As String

If (CStr(ThisWorkbook.ActiveSheet.Name) = "Rechnung") Then

Result = MsgBox("Rechnung fertig?", vbApplicationModal Or vbQuestion Or vbYesNo)

If Result = vbNo Then Exit Sub

End If

Const DateiPfad = "C:\Temp\"

Dim DateiName As String

DateiName = DateiPfad & Range("C15") & Range("D15") & ".pdf"

Range("A1:F54").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

DateiName, Quality:=xlQualityStandard, _

IncludeDocProperties:=True, _

IgnorePrintAreas:=False, _

OpenAfterPublish:=False

Dim Nachricht As Object, OutApp As Object

Dim AWS As String

Set OutApp = CreateObject("Outlook.Application")

AWS = strFileName

'InitializeOutlook = True

Set Nachricht = OutApp.CreateItem(0)

With Nachricht

.Subject = "" & Range("A1") & "_" & Range("C15") & Range("D15")

.GetInspector.display

'.Attachments.Add ("C:\Temp\" & Range("C15") & Range("D15") & ".pdf")

End With

Set OutApp = Nothing

Set Nachricht = Nothing

End Sub

...zur Frage

Hey, wie bekomme ich via Excel VBA eine Mail bei Lotus Notes geschrieben, sodass ich sie vorher noch bearbeiten kann?

Sobald ich die Mail ohne Bearbeitung verschicke, ist die Mail inklusive des Inhaltes. Sobald ich sie bearbeiten will vorher bzw. noch einmal manuell auf "senden" drücken will (Vorsichtsmaßnahme), ist der komplette Inhalt, bis auf die Betreffzeile, verschwunden.

Beiliegend ist mein Codebeispiel

Sub SendNotesMail2()

Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim Maildb As Object
Dim MailDoc As Object
Dim session As Object
Dim stSignature As String



With Application
.ScreenUpdating = False
.DisplayAlerts = False


AWS = ActiveWorkbook.FullName
Set Worksheet = Application.ActiveWorkbook.Worksheets.Item(1)
Set session = CreateObject("Notes.NotesSession")
Set Maildb = session.CURRENTDATABASE
Set MailDoc = Maildb.createdocument
MailDoc.Form = "Memo"
Set Workspace = CreateObject("Notes.NOTESUIWORKSPACE")
stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
Recipient = "f"
MailDoc.display = ""
MailDoc.copyto = "" 
MailDoc.subject = "price update"
MailDoc.SAVEMESSAGEONSEND = saveit
Set ritem = MailDoc.CreateRichTextItem("Body")
For i = 2 To 37
With ritem
        .AppendText ("")
        .AppendText (Cells(i, 2).Value & vbTab & Cells(i, 3).Value & vbTab & Cells(i, 4).Value & vbTab & Cells(i, 5).Value & vbTab)
        .addnewline (1)
End With
Next
For i = 2 To 2
With ritem
        .AppendText ("" & vbCrLf & vbCrLf & stSignature)
End With
Next


Call Workspace.editdocument(True, MailDoc).GOTOFIELD("subject")


MailDoc.PostedDate = Now()

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachMe = Nothing
Set session = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
End With
Range("a1").Select
End Sub

...zur Frage

Maximale Pfadlänge in Windows und VBA umgehen?

Hallo,

ich benutze folgenden Code in Excel VBA um mir Dateipfad und Dateiname eines Ordners und allen darin enthaltenen Unterordnern aufzulisten.
(Ihr könnt es testen, den Code einfach in ein Modul kopieren, "MainList" ausführen und einen Ordner eurer Wahl auswählen)

Ich habe jetzt das Problem, dass dieser Code alle Dateien überspringt, deren Pfadlänge über 255 Zeichen lang ist. Einige Dateien überschreiten nämlich die 255 Zeichen mit dem angehängten Dateinamen.
Sie liegen aber dennoch ab. Nur liest VBA diese nicht aus. Kann man da was dran machen?

Sub MainList()
'Updateby Extendoffice
Set Folder = Application.FileDialog(msoFileDialogFolderPicker)
If Folder.Show <> -1 Then Exit Sub
xDir = Folder.SelectedItems(1)
Call ListFilesInFolder(xDir, True)
End Sub

Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
  Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Path
  Application.ActiveSheet.Cells(rowIndex, 2).Formula = xFile.Name
  rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
  For Each xSubFolder In xFolder.SubFolders
    ListFilesInFolder xSubFolder.Path, True
  Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub

Function GetFileOwner(ByVal xPath As String, ByVal xName As String)
Dim xFolder As Object
Dim xFolderItem As Object
Dim xShell As Object
xName = StrConv(xName, vbUnicode)
xPath = StrConv(xPath, vbUnicode)
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.Namespace(StrConv(xPath, vbFromUnicode))
If Not xFolder Is Nothing Then
  Set xFolderItem = xFolder.ParseName(StrConv(xName, vbFromUnicode))
End If
If Not xFolderItem Is Nothing Then
  GetFileOwner = xFolder.GetDetailsOf(xFolderItem, 8)
Else
  GetFileOwner = ""
End If
Set xShell = Nothing
Set xFolder = Nothing
Set xFolderItem = Nothing
End Function

...zur Frage

VBA text Body wird teilweise in Zelle geschrieben anstatt in eMail?

Hallo,

ich habe folgendes Makro erstellt, um automatische eMail Anfragen in Outlook zu generieren und an manchen Tagen kommt es vor, dass der Text Body in eine Zelle des Excel Sheets geschrieben wird, anstatt in die eMail selbst, hier wird dann zwar die eMail generiert, aber lediglich mit den Empfängern und den Betreff. Woran kann das liegen und wie kann ich Abhilfe schaffen.

Sub Amendment_Initial_Capturing()

Dim olApp As Object

Dim objOutlook As Object

Dim objMail As Object

Dim Text As String

Set olApp = CreateObject("Outlook.Application")

Set objMail = olApp.CreateItem(0)

Text = "Dear all, " & Chr(13) & Chr(13) & " please perform the amendment of the initial capturing. Thanks."

With objMail

'.GetInspector ' sorgt für die Signatur

.To = "xxxxx"

.cc = "xxxxx"

.Subject = "DEALNAME - AMENDMENT INITIAL CAPTURING"

.Display

End With

SendKeys Text

Set olApp = Nothing

End Sub

...zur Frage

VBA nur die ersten Unterordner anzeigen lassen?

Hallo,

wie muss ich diesen Code hier umschreiben damit NICHT die Unterordner der Unterordner angezeigt werden, sondern nur die der 'ersten Stufe'.

Also angenommen auf dem Laufwerk C:\ sind die Ordner

A, B, C, D, E

und diese Unterordner von C:\ enthalten jeweils auch Unterordner Namens
aa, bb, cc, dd, ee,

Dann schreibt der bisherige Code

A - aa
bb
cc
dd
ee
B - aa
bb

und so weiter.
Ich brauche aber nur die Ordner A, B, C, D, E und nicht deren Unterordner.

Public Sub OrdnerListen_Start()

Dim fso As Object
Dim strPfad As String

strPfad = "C:\"

With ActiveSheet

.UsedRange.ClearContents

Set fso = CreateObject("Scripting.FileSystemObject")

Call OrdnerListen(fso, strPfad, .Range("A1")) ' Pfad anpassen!

Set fso = Nothing

End With

End Sub

Private Sub OrdnerListen(fso As Object, Ordnerangabe As String, rng As Range, Optional Zeile As Long, Optional Spalte As Long)

On Error Resume Next

Dim o, uo

Set o = fso.GetFolder(Ordnerangabe)

rng.Offset(Zeile, Spalte).Value = o.Name
Zeile = Zeile + 1

For Each o In o.SubFolders

Call OrdnerListen(fso, o.Path, rng, Zeile, Spalte)

Set o = Nothing
Set uo = Nothing

End Sub

...zur Frage

Ich benötige einen Makro, um ausgewählte Filter beim Schliessen zurück zu setzen. Aber mit dem Blattschutz funktioniert das nicht mehr. Kann mir jemand helfen?

Ich habe bisher diesen Makro benutzt:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim wksSheet As Worksheet
    For Each wksSheet In ThisWorkbook.Worksheets
        With wksSheet
            If .AutoFilterMode Then
                If .FilterMode Then
                    .ShowAllData
                End If
            End If
        End With
    Next wksSheet
    ThisWorkbook.Save
End Sub

...zur Frage

VBA: Zwei Spalten mit Wert multiplizieren und dann addieren mit Hilfe von Makros

Hallöchen,

ich habe folgendes Problem Ich habe zwei Spalten die ich jeweils miteinander addieren möchte. Doch bevor ich diese addiere, möchte ich Spalte B mit dem Wert aus der TextBox1 multiplizieren und Spalte C mit dem Wert aus Textbox2. Danach sollen beide Spalten miteinander addiert und dann sortiert werden. Spalte D ist in diesem Fall die Ergebnisspalte. Das Programm hat auch schon funktioniert, jedoch habe ich vorher nur die spalten addiert und sortiert.

HIer mein bereits geschriebener Code:

Private Sub CommandButton1_Click()



' Prüfen ob Lastspitzen eingetragen wurden, ansonsten Fehlermeldung

        If TextBox1.Value = "" Or TextBox2.Value = "" Then
        MsgBox "Bitte geben Sie eine Lastspitze ein!"
     
Else
        
Dim wks As Excel.Worksheet
Dim lngLetzteZeile As Long
Dim Last1 As Integer
Dim Last2 As Integer
Last1 = TextBox1.Value
Last2 = TextBox2.Value  

Set wks = ActiveWorkbook.Worksheets("Vergleich")


With wks
 
lngLetzteZeile = .Cells(.Rows.Count, "B").End(xlUp).Row
If lngLetzteZeile < 15 Then Exit Sub

 With .Range("D15:D" & lngLetzteZeile)
 'berechne: D := B + C
 .FormulaR1C1 = "=RC[-2]*Last1+RC[-1]*Last2"
 'Formeln durch deren Ergebnis ersetzen
 .Value = .Value
 End With
 
With .Range("B15:D" & lngLetzteZeile)
 .Sort Key1:=.Cells(2), Order1:=xlDescending, _
 DataOption1:=xlSortTextAsNumbers, _
 SortMethod:=xlPinYin
End With

End With
End If


End Sub

...zur Frage

Makro: wie kann ich einen Tabellenbereich + Bild in einer E-Mail im Body versenden?

hallo nochmal,

ich möchte gerne dass ich einen bestimmten Tabellenbereich aus Excel in einer Email versenden kann (nicht als Anhang, sondern im Textfeld, und nicht als Screenshot). das klappt bisher auch gut bei mir. jedoch ist da auch ein Logo mit drin, dass ich nicht anzeigen lassen kann (ein eingefügtes Bild). was muss ich da ändern?

mein makro sieht jetzt teilweise so aus:

Bodyteil der EMail:

.HTMLBody = fncRangeToHtml("E-Mail", "F13:O37")

und die funktion dazu:

Private Function fncRangeToHtml(strWorksheetname As String, _ strRangeaddress As String) As String Dim objFilesytem As Object, objTextstream As Object Dim strFilename As String strFilename = Environ$("temp") & "/" & _ Format(Now, "dd-mm-yy h-mm-ss") & ".htm" ActiveWorkbook.PublishObjects.Add( _ SourceType:=xlSourceRange, _ Filename:=strFilename, _ Sheet:=strWorksheetname, _ Source:=strRangeaddress, _ HtmlType:=xlHtmlStatic).Publish True Set objFilesytem = CreateObject("Scripting.FileSystemObject") Set objTextstream = objFilesytem.GetFile(strFilename). _ OpenAsTextStream(1, -2) fncRangeToHtml = objTextstream.ReadAll objTextstream.Close Set objTextstream = Nothing Set objFilesytem = Nothing Kill strFilename End Function

es liegt bestimmt an dem htmlbody, aber ich habe keine bessere lösung gefunden mit der es bisher gklappt hat

...zur Frage

VB.NET programmieren. Counter beim drücken eines Buttons?

Guten Tag,

Ich verzweifle grad an der wahrscheinlichsten einfachsten Frage.

Wie zähle ich eine Zahl hoch, wenn ich auf ein Button drücke. Habe es immer mit

counter = counter + 1

oder

counter += 1

gemacht. Funktioniert diesmal auch, aber nur 1x | Ich drücke auf den Button und er zählt von 0 auf 1 hoch. Drücke ich ihn nochmal, geht es nicht mehr und bleibt bei der 1

Code:

    Private Sub btn_startGame_Click(sender As Object, e As EventArgs) Handles btn_startGame.Click
        counter()
    End Sub

    Public Sub counter()
        Dim counter As Integer = 0
        counter = counter + 1
        Label1.Text = counter
    End Sub

...zur Frage

Name + User?

Hallo,

was müsste ich hier anpassen? Ich komme mit der Fehler Meldung nicht zurecht.

Private Declare 36 GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Function GetNTUserA() As String
  
 Dim sBuffer As String
 Dim LSize As Long
 Dim user As String
  
 sBuffer = Space$(255)
 LSize = Len(sBuffer)
  
 Call GetUserName(sBuffer, LSize)
  
 If LSize > 0 Then
  user = Left$(sBuffer, LSize - 1)
 Else
  user = vbNullString
 End If
  
 GetNTUserA = user
  
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
   
    If Target.Column = 6 Then
    Target.Offset(0, 11).Value = Date
  End If
      
    If Target.Column = 6 Then
    Target.Offset(0, 10).Value = GetNTUserA
  End If

End Sub

...zur Frage

Excel mit Dialog ins Access importieren?

Hallo zusammen,

für den Import einer CSV mit Dialog(um beliebige Datei zu wählen) benutze ich folgender Code:

---------

Private Sub Befehl14_Click()

Dim fd As Object

Dim dateiname As String

Set fd = Application.FileDialog(1)

fd.AllowMultiSelect = False

fd.ButtonName = "Importieren"

With fd

If .Show = True Then

dateiname = fd.SelectedItems(1)

'DoCmd.TransferText acImportDelim, "txtImportSpezifikation", "Sales", dateiname

DoCmd.TransferText acImportDelim, "LEER1", "Sales", dateiname

Else

Set fd = Nothing

End If

End With

End Sub

--------

will gerne aber für Excel- Was muss ich am besten anpassen an den Code?

Vielen Dank im voraus

Gruß

Sahaj

...zur Frage

VBA Wenn eine Zelle mehrerer Spalten leer dann msgbox?

Hallo zusammen,

ich habe vor in mehreren Spalten zu kontrollieren, ob sich eine leere Zelle befindet. Wenn ja soll eine Msgbox angezeigt werdne und der Sub soll beendet werden. Wenn nicht soll er fortfahren. Allerdings kommt es bei mir zu einer Fehlermeldung "Typen unverträglich". Wo hat sich der Fehler eingeschlichen? End If befindet sich weiter unten.

Sub SendMeetingRequest_2()

Dim Bereich As Range

Set Bereich = Range("F2:H41", "B2:B41") 'Zellbereich

With Application.WorksheetFunction

Dim objOL As Object 'As Outlook.Application

Dim objAppt As Object 'As Outlook.AppointmentItem

'Const olAppointmentItem = 1

Const olMeeting = 1

Dim ReminderTime As Long

Dim lfdnr As Integer

lfdnr = 2

'Überprüfung erstellen falls Aufgaben leer sind

'lfdnr = 4

If Bereich.Value = "" Then

MsgBox "Bitte fehlende Daten eintragen"

Call Leere_zellen_hervorheben

Exit Sub

Else

Danke für eure Hilfe!

...zur Frage

Wieso unverträgliche Typen bei diesem Code?

Hi, da bin ich wieder. Nun bin ich wieder einen guten Schritt weiter.

Problem: Ich habe geschlossene Textmarker in Word, dessen Inhalt über Excel gefüllt/ersetzt werden soll.

Ich habe folgenden Code:

Public Sub ReSetBookmark(ByVal doc As Object, ByVal TMName As String, ByVal TMInhalt As String)
'Recycling-Textmarke mit übernommenen Werten, geht für alle Textmarken


    Dim bm As Bookmark
    Dim rng As Range
   
    If doc.Bookmarks.Exists(TMName) Then
        Set bm = doc.Bookmarks(TMName)
        Set rng = bm.Range
        rng.Text = TMInhalt
        doc.Bookmarks.Add Name:=TMName, Range:=rng
    End If
   
    Set rng = Nothing
    Set bm = Nothing
   
End Sub

Der Code wurde im Netz mehrfach geposted.

Nur erhalte ich einen Fehler wegen Typenunverträglichkeit in dieser Zeile:

        Set rng = bm.Range

wenn ich aber mit der Maus draufzeige, sehe ich dass der Inhalt dieser Range richtig angezeigt wird: " " (im Bereich der Textmarke ist nur ein Leerzeichen).

Ich verstehe einfach nicht, warum der Code nun stehen bleibt.

Kann bitte jemand helfen?

Dankeschön.

...zur Frage

Excel - Speicher-datum in Kopfzeile?

möchte immer das letzte Speicherdatum in der Kopfzeile. Habe bereits mehrere Lösungen gegoogelt, aber funktionieren tun sie nicht. Wo mache ich den Fehler?

Habe folgenden Befehl eingegeben

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim booIsSaved As Boolean
Dim strDatInfo As String
With ThisWorkbook
booIsSaved = .Saved
If .Path <> "" Then
strDatInfo = .BuiltinDocumentProperties("Last save time")
Else
strDatInfo = "noch nicht gespeichert"
End If
ActiveSheet.PageSetup.LeftHeader = "Zuletzt gespeichert: " & strDatInfo
.Saved = booIsSaved
End With
End Sub

Und hier noch einen printscreen. Besten Dank

...zur Frage

Was möchtest Du wissen?

Deine Frage stellen