Mail verzenden in outlook van standaard mailadres

[Schipper1994]

ik wil in outlook een mail versturen via VBA.

ik had gehoopt dat deze standaard van het vast verzendadres (ingesteld in outlook) zou versturen.
Hij verstuurd het jammer genoeg van een ander mailadres. ( ik heb 4 verschillende mailadressen in mijn outlook)

hoe zou ik dit eventueel kunnen laten verzenden van het standaard mailadres?

hieronder vind u de code die ik gebruik, ik ben geen held in vba maar trek men plan via internet.
deze code is ook samengesteld via internet. echter vind ik nu mijn antwoord nergens.

ik vond wel dingens met sendusingaccount enz maar ik krijg het maar niet toegepast.

Sub Saveaspdfandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range
 
Set xSht = Worksheets("testsheet")
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

    With xFileDlg
       .InitialFileName = Sheets("settings2").Range("b2")
    End With
    

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If

xFolder = xFolder + "\" & xSht.Cells(19, 4) & " " & xSht.Cells(22, 9) & ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & "Bestaat al." & vbCrLf & vbCrLf & "Wilt u deze overschrijven?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "Deze sheet is niet opgeslagen." _
                    & vbCrLf & vbCrLf & "Druk OK om af te sluiten", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
     
    'Create Outlook email
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = xSht.Cells(13, 3)
        .CC = ""
        .Subject = xSht.Cells(19, 4) & " " & xSht.Cells(22, 9)
        .Attachments.Add xFolder
        If DisplayEmail = False Then
        End If
    End With
Else
  MsgBox "sheet mag niet blanco zijn"
  Exit Sub
End If
End Sub

 

[alphamax]

Kijk eens hier, zie https://www.rondebruin.nl/win/s1/outlook/account.htm

[COLOR="#FF0000"]Dim xAccount As Object[/COLOR]
    
    If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'        Save as PDF file
        xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard

'        Create Outlook email
        Set xOutlookObj = CreateObject("Outlook.Application")
        Set xEmailObj = xOutlookObj.CreateItem(0)
        [COLOR="#FF0000"]Set xAccount = xOutlookObj.Session.Accounts.Item(2)[/COLOR] 'account 2
        With xEmailObj
            .Display
            .To = xSht.Cells(13, 3)
            .CC = ""
            .Subject = xSht.Cells(19, 4) & " " & xSht.Cells(22, 9)
            [COLOR="#FF0000"]Set .SendUsingAccount = xAccount[/COLOR]
            .Attachments.Add xFolder
            If DisplayEmail = False Then
            End If
        End With
    Else
        MsgBox "sheet mag niet blanco zijn"
        Exit Sub
    End If

Getest met windows11en en office2007nl

Tip: Jouw code kan beter en stabieler, gebruik de zoekfunctie van dit forum, er zijn honderden vragen van outlook mails maken met excel (dus ga ik/wij niet alles nog een keer uitleggen )

 

[Schipper1994]

dit had ik ook al eens ingevoegd maar misschien met een foutje. ik ga het nakijken en proberen.

 

[Schipper1994]

dank u, het werkt. alleen moest in mijn geval de 2 een 1 worden.

ik was toen ik dit probeerde de SET vergeten bij .Usingaccount

dank U

ook voor de stabielere mailing zal ik eens gaan rond neuzen. maar voorlopig werkt deze prima voor mij en met men bijlage.