80% werkende code

Status
Niet open voor verdere reacties.

Ron001

Gebruiker
Lid geworden
4 dec 2017
Berichten
384
Beste

Met de code hieronder stuurt persoon A, een email naar persoon B en mezelf.
Met de code hieronder stuurt persoon B, een email naar persoon A en mezelf.

Dus enkel deze twee personen kunnen de email sturen (lees: de macro gebruiken)

Als derde Case Else krijgt de rest te zien dat ze geen toegang hebben, werkt ook...
Maar ik krijg alleen in de MsgBox de 'Replace(Environ("username"), ".", " ")', niet in.
Krijg hier steeds foutmelding op, hoe komt dit?

Mvg

Code:
Sub email()

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Select Case LCase(Environ("username"))

Case Is = "Persoon A"

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        strbody = "tekst email van Persoon A naar B en mezelf”
                  
                  

        On Error Resume Next
        With OutMail
            .To = "email"
            .CC = "email"
            .BCC = ""
            .Subject = "Tekst"
            .HTMLBody = strbody
            .Display   'or use .Send
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing


Case Is = "Persoon B"
   
    
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        strbody = " tekst email van Persoon B naar A en mezelf”
                  

        On Error Resume Next
        With OutMail
            .To = "email"
            .CC = "email"
            .BCC = ""
            .Subject = "Tekst"
            .HTMLBody = strbody
            .Display   'or use .Send
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
        
    
   Case Else:
   MsgBox "for you: access denied!!!", vbOKOnly + vbCritical, "Warning"
   
   End Select

End Sub


'Replace(Environ("username"), ".", " ")

Zou moeten worden: MsgBox "Replace(Environ("username"), ".", " "), for you: access denied!!!", vbOKOnly + vbCritical, "Warning"
 
Laatst bewerkt:
Hoe heb je die 80% berekend ?:rolleyes:

Gebruik

Code:
Select Case LCase(Environ("username"))
Case "Persoon A"

Case "Persoon B"

End Select

Verwijder de regel met BCC="" (zinloos als je hem toch niet gebruikt.
 
Laatst bewerkt:
Hoe heb je die 80% berekend ?
Moet toch iets schrijven :)

Geeft steeds fout op Username hier:
Code:
MsgBox "Replace(Environ("username"), ".", " "), for you: access denied!!!", vbOKOnly + vbCritical,
Verwacht instructie einde...
 
Er klopt ook weinig van die syntax. Maak er dit van:
Code:
MsgBox Replace(Environ("username"), ".", " ") & ", " & vbCrLf & "for you: access denied!!!", vbCritical, "Warning"
 
Laatst bewerkt:
Toch nog ff één vraag...Puur uit nieuwsgierigheid... (niks nuttig...)

Is het ook nog mogelijk om de gebruikersnaam uit te middelen in de MsgBox?
 
Daar is geen standaard instelling voor.

Nog wel een advies voor je mail code (80% ingekort ;)):
Code:
Sub Email()
    Dim mTo As String
    Dim mCC As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    
    Select Case LCase(Environ("username"))
        Case Is = "persoon a":  mTo = "Aan email": mCC = "CC email"
        Case Is = "persoon b":  mTo = "Aan email": mCC = "CC email"
        Case Else
            MsgBox Replace(Environ("username"), ".", " ") & ", " & vbCrLf & "for you: access denied!!!", vbCritical, "Warning"
            Exit Sub
    End Select

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "tekst email van Persoon A naar B en mezelf”"
    With OutMail
        .To = mTo
        .CC = mCC
        .BCC = ""
        .Subject = "Tekst"
        .HTMLBody = strbody
        .Display   [COLOR="#008000"]'or use .Send[/COLOR]
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 
Laatst bewerkt:
Deze code is voldoende

Code:
Sub M_snb()
  Select Case LCase(Environ("username"))
  Case "persoon a","persoon b"
    with  CreateObject("Outlook.Application").CreateItem(0)
        .To = iif(LCase(Environ("username"))="persoon a","persoon b", "persoon a")
        .CC = Environ("username")
        .Subject = "Tekst"
        .Body = "overzicht"
        .Send
    End With
  end select
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan