Newsgroup: it.comp.lang.visual-basic
Titolo: Shellexecute(Mailto: Non allega file (in windows 2000))

Ciao a Tutti.
Potete provare questo codice e confermarmi che sotto windows 2000
non si riesca ad aggiungere Attachment con ShellExecute.
### Modulo Esegui:
Option Explicit
Private Declare Function ShellExecute Lib "Shell32.dll" Alias
"ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal
lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String,
ByVal nShowCmd As Long) As Long
Private Declare Function ShellExecuteForExplore Lib "Shell32.dll" Alias
"ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal
lpFile As String, lpParameters As Any, lpDirectory As Any, ByVal nShowCmd As
Long) As Long
Public Enum ConstantiShellWindows
     essSW_HIDE = 0
     essSW_MAXIMIZE = 3
     essSW_MINIMIZE = 6
     essSW_SHOWMAXIMIZED = 3
     essSW_SHOWMINIMIZED = 2
     essSW_SHOWNORMAL = 1
     essSW_SHOWNOACTIVATE = 4
     essSW_SHOWNA = 8
     essSW_SHOWMINNOACTIVE = 7
     essSW_SHOWDEFAULT = 10
     essSW_RESTORE = 9
     essSW_SHOW = 5
End Enum
Private Const ERRORE_FILE_NON_TROVATO = 2&
Private Const ERRORE_PATH_NON_TROVATO = 3&
Private Const ERRORE_FORMATO_FILE = 11&
Private Const ERRORE_ACCESSO_NEGATO = 5
Private Const ERRORE_ASSOCIAZIONE_NONVALIDA = 27
Private Const ERRORE_BUSY = 30
Private Const SE_ERR_DDEFAIL = 29
Private Const ERRORE_DI_TIMEOUT = 28
Private Const ERRORE_DLL_NON_TROVATA = 32
Private Const SE_ERR_FNF = 2
Private Const ERRORE_DI_ASSOCIAZIONE = 31
Private Const SE_ERR_PNF = 3
Private Const SE_ERR_OOM = 8
Private Const ERRORE_DI_VIOLAZIONE = 26
Public Function Esegui( _
        ByVal File As String, _
        Optional ByVal Finestra As ConstantiShellWindows =
essSW_SHOWDEFAULT, _
        Optional ByVal Parametri As String = "", _
        Optional ByVal DefaultDir As String = "", _
        Optional Operazione As String = "Open", _
        Optional Owner As Long = 0 _
    ) As Boolean
Dim lR As Long
Dim lErr As Long, sErr As Long
    If (InStr(UCase$(File), ".EXE") <> 0) Then
        Finestra = 0
    End If
    On Error Resume Next
    If (Parametri = "") And (DefaultDir = "") Then
        lR = ShellExecuteForExplore(Owner, Operazione, File, 0, 0,
essSW_SHOWNORMAL)
    Else
        lR = ShellExecute(Owner, Operazione, File, Parametri, DefaultDir,
Finestra)
    End If
    If (lR < 0) Or (lR > 32) Then
        Esegui = True
    Else
        'Gestione errori
        lErr = vbObjectError + 1048 + lR
        Select Case lR
        Case 0
            lErr = 7: sErr = "Memoria Esaurita"
        Case ERRORE_FILE_NON_TROVATO
            lErr = 53: sErr = "File non trovato!."
        Case ERRORE_PATH_NON_TROVATO
            lErr = 76: sErr = "Path non valido!."
        Case ERRORE_FORMATO_FILE
            sErr = "Il File eseguibile non è valido ,potrebbe essere
corrotto"
        Case ERRORE_ACCESSO_NEGATO
            lErr = 75: sErr = "Path/file errore di accesso"
        Case ERRORE_ASSOCIAZIONE_NONVALIDA
            sErr = "Questo tipo di file non ha un'associazione valida"
        Case ERRORE_BUSY
            lErr = 285: sErr = "Il file non puo' essere aperto perche
l'Applicazione è occupata. Riprovare in un altro momento."
        Case SE_ERR_DDEFAIL
            lErr = 285: sErr = "Il file non puo' essere aperto perche' la
transazione DDE è fallita. Riprovare in un altro momento."
        Case ERRORE_DI_TIMEOUT
            lErr = 286: sErr = "Errore di timeout"
        Case ERRORE_DLL_NON_TROVATA
            lErr = 48: sErr = "Impossibile trovare la dinamik link library"
        Case SE_ERR_FNF
            lErr = 53: sErr = "File non trovato"
        Case ERRORE_DI_ASSOCIAZIONE
            sErr = "Questo tipo di file non ha un'associazione valida"
        Case SE_ERR_OOM
            lErr = 7: sErr = "Memoria esaurita"
        Case SE_ERR_PNF
            lErr = 76: sErr = "Path non trovato"
        Case ERRORE_DI_VIOLAZIONE
            lErr = 75: sErr = "Errore di violazione."
        Case Else
            sErr = "Errore generico di violazione"
        End Select
        Err.Raise lErr, , App.EXEName & ".Shell", sErr
        Esegui = False
    End If
End Function
###     Fine Modulo
Public Function Invia_EmailA( ByRef Indirizzo As String, ByRef IDOrdine As
Long,ByRef TestoMsg As String, _
                                          ByRef Allegato As String, Optional
ByRef CC As String, Optional ByRef BCC As String) As String
Dim Mail As String
Dim TestoAgg As String
Dim Corpo As String
Dim Oggetto As String
Corpo = "Vogliamo Inviarle n.s copia dell'Ordine n°" & IDOrdine
Oggetto = "Ordine Materiale "
If Len(Indirizzo) Then
    Mail = Indirizzo
End If
If Len(Oggetto) Then
    TestoAgg = TestoAgg & "?Subject=" & Oggetto
End If
If Len(CC) Then
    TestoAgg = TestoAgg & "&CC=" & CC
End If
If Len(BCC) Then
    TestoAgg = TestoAgg & "&BCC=" & BCC
End If
If Len(Corpo) Then
    TestoAgg = TestoAgg & "&Body=" & Corpo & vbCr & " : " & TestoMsg
End If
If Len(Allegato) Then
    TestoAgg = TestoAgg & "&Attach=" & Chr(34) & Allegato & Chr(34)
End If
Mail = "Mailto:" & Mail
If Len(TestoAgg) <> 0 Then
    Mid$(TestoAgg, 1, 1) = "?"
End If
Mail = Mail & TestoAgg
If Len(Mail) Then
    Call Esegui(Mail, essSW_SHOWNORMAL, vbNullString, vbNullString, "open")
End If
Invia_EmailA = Indirizzo
End Function
Provare poi il tutto con :
      Call Invia_EmailA(1, "
virtu...@tiscalinet.it
", "prova Messaggio",
"C:\Prova.txt") ' createvi ovviamente un file di testo             prova.txt
sarà ma funziona tutto tranne l'Attachment
Aspetto numerose conferme!!
Grazie
By Utente Win2k

 Aspetto numerose conferme!!
confermo non solo che non va sotto Windows 2000, ma anche che non va
sotto 95 e 98 e suppongo su tutti i f*****i sistemi M$ in cui OE è il
gestore predefinito per la posta elettronica
Faber