Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Invio di un pdf tramite gmail

126 views
Skip to first unread message

ale

unread,
Oct 9, 2015, 4:07:21 AM10/9/15
to
Ciao a tutti,
ho un foglio xls dalla cui stampa mi creo un pdf (e fino a qui nessun problema).
Questa stampa appena creata la vorrei inviare via mail.
Tutto in automatico. Quindi andando a puntare su delle celle dove avrò i cc, l'oggetto, il corpo, ecc....
Ho trovato navigando qualcosa che può fare al mio caso
http://www.learnexcelmacro.com/wp/20...mail-or-yahoo/
oppure via youtube
https://www.youtube.com/watch?v=pFl7W8d7d4M
ma è senza allegato...
l'ho provato ma mi da
errore di run-time '-2147220973(80040213)' il trasporto non è riuscito a connettersi al server
sulla penultima riga
NewMail.Send

qui invece è con l'allegato
http://www.excelforum.com/excel-prog...-in-macro.html
ho provato ma ovviamente non mi parte.
Qualcuno può aiutarmi...magari già ci è passato e...
Grazie anche per dei consigli.
ciao
ale

casanmaner

unread,
Oct 9, 2015, 5:32:17 AM10/9/15
to
A me ha funzionato, anche con l'allegato, solo dopo aver impostato nelle opzioni GMAIL la possibilità di ricevere da APP "non sicure".
Questa la procedura che ho ricreato:

Option Explicit

Public Function send_email_via_gmail()
Dim MyMail As CDO.Message
Dim my_address As String
Dim my_pw As String
Dim send_email
Dim my_attachment As String

my_address = "mioindirizzoemail"
my_pw = "miapassword"
send_email = "indirizzoemaildestinatario"
my_attachment = "C:\test.pdf"

Set MyMail = New CDO.Message
With MyMail.Configuration.Fields

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = my_address
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = my_pw
.Update
End With


With MyMail
.To = send_email
.From = my_address
.Subject = "Test Invio Email con VBA via Gmail"
.TextBody = "Test Invio Email tramite Gmail con utilizzo VBA"
.AddAttachment my_attachment
.Send
End With
Set MyMail = Nothing
End Function

ale

unread,
Oct 9, 2015, 7:55:14 AM10/9/15
to
ciao e grazie per la risposta...purtroppo non va...ma penso che dipenda da quell'impostazione app non sicure.
cmq pensavo di aggirare il problema.
da un tuo vecchio post grazie a questa che funziona alla grande

Sub TestImpostaAreaStampa_E_StampaPdf_II()
Dim FoglioDaStampare As Worksheet
Dim PrimaCellaPivot As Range
Dim PrimaCellaAreaStampa As String
Dim UltimaCellaAreaStampa As String
Dim PathFile As String
Dim NomeFile As String
Dim ArrayCaratteriVietati As Variant

'=== Impostazione riferimenti a fogli e celle ==='
Set FoglioDaStampare = ActiveSheet '<=== inserire il riferimento al foglio da stampare e dove impostare l'area di stampa
With FoglioDaStampare
PrimaCellaAreaStampa = .Range("A1").Address '<=== inserire il riferimento alla prima cella dell'area di stampa
Set PrimaCellaPivot = .Range("B17") '<=== inserire il riferimento alla cella da dove parte la tabella
NomeFile = .Range("C13").Value '<=== inserire il riferimento alla cella che contiene il nome da dare al file PDF
End With
PathFile = Application.DefaultFilePath & Application.PathSeparator '<=== inserire qui il riferimento alla Path dove verrà salvato il PDF
'=== Impostazione riferimenti a fogli e celle ==='

With PrimaCellaPivot.CurrentRegion
UltimaCellaAreaStampa = .Cells(.Rows.Count, .Columns.Count).Address
End With

ArrayCaratteriVietati = Array("/", "\", "?", "*", ":", "|", """", "<", ">")
For i = 0 To UBound(ArrayCaratteriVietati)
NomeFile = Replace(NomeFile, ArrayCaratteriVietati(i), "-")
Next i

With FoglioDaStampare
.PageSetup.PrintArea = PrimaCellaAreaStampa & ":" & UltimaCellaAreaStampa
On Error Resume Next
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PathFile & NomeFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End With

Set PrimaCellaPivot = Nothing
Set FoglioDaStampare = Nothing
End Sub


riesco a stampare delle pivot in pdf.

ma se volessi,sempre partendo da una pivot, avere tante stampe quante sono le varie scelte in un filtro pivot?
Mi spiego. Vorrei poter fare in modo che si sceglie (nei filtri pivot) il nome di un team: a questo team sono associati n nominativi (inseriti in una tabellina). Quando si sceglie un team xls si vede quali sono questi nominativi, li filtra nel campo pivot passando da Tutti() ai singoli specifici nomi e salva in pdf il risultato, poi passa al secondo nome e via fino all'ultimo nome del team.
In questo modo avrò tutti i pdf stampati e poi me li vado a allegare alla mail...poi se trovo il modo di aggirare l'invio ben venga...ma per il momento già raggiungere questo sarebbe un bel passo.
ciao
ale

casanmaner

unread,
Oct 9, 2015, 9:55:53 AM10/9/15
to
Ho molta poca dimestichezza con le tabelle pivot.
Però penso che dovresti fare in modo che la procedura, in base al nominativo che ti interessa, effettui il filtro e poi far partire la procedura per la stampa pdf del foglio "filtrato".
Prova a registrare una macro dove applichi il filtro in base ad un dato nominativo e guarda che cosa serve per poter filtrare i dati tramite vba.

ale

unread,
Oct 9, 2015, 10:19:21 AM10/9/15
to
sto lavorando in questo modo: mi conto quanti nominativi sono per quel team selezionato.Poi mi sono costruito un'altra pivot con la quale ho tutti i nominativi associati ai vari team, cosìchè da sapere da quale riga partire e fino a quale riga arrivare e avere così i nominativi del solo team selezionato.
Poi con un for faccio partire la tua procedura.
Questo sulla carta...cmq ti faccio sapere.
grazie ancora
ciao
ale

ale

unread,
Oct 9, 2015, 11:23:06 AM10/9/15
to
ho fatto questo:

Sub StampaPdf()
Dim FoglioDaStampare As Worksheet
Dim EC As String
EC = "Estratto Conto Leader "
Dim PrimaCellaPivot As Range
Dim PrimaCellaAreaStampa As String
Dim UltimaCellaAreaStampa As String
Dim PathFile As String
Dim NomeFile As String
Dim ArrayCaratteriVietati As Variant

'=== Impostazione riferimenti a fogli e celle ==='
Set FoglioDaStampare = ActiveSheet
With FoglioDaStampare
PrimaCellaAreaStampa = .Range("A1").Address
Set PrimaCellaPivot = .Range("A13")
NomeFile = .Range("B10").Value
End With
PathFile = Application.DefaultFilePath & Application.PathSeparator
'=== Impostazione riferimenti a fogli e celle ==='

With PrimaCellaPivot.CurrentRegion
UltimaCellaAreaStampa = .Cells(.Rows.Count, .Columns.Count).Address
End With

ArrayCaratteriVietati = Array("/", "\", "?", "*", ":", "|", """", "<", ">")
For I = 0 To UBound(ArrayCaratteriVietati)
NomeFile = Replace(NomeFile, ArrayCaratteriVietati(I), "-")
Next I
MsgBox NomeFile
With FoglioDaStampare
.PageSetup.PrintArea = PrimaCellaAreaStampa & ":" & UltimaCellaAreaStampa
On Error Resume Next
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PathFile & EC & NomeFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With

Set PrimaCellaPivot = Nothing
Set FoglioDaStampare = Nothing
End Sub

Sub ale()
'*************controllo il DefPath******************
Dim DefPath As String
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'*************controllo il DefPath******************
Dim DAA
tec = Cells(2, 9) '21
MsgBox tec
team = Cells(1, 9) '9
'*****controllo se è stato scelto un team o meno*******************
Dim risp
aHelp = "DEMO.HLP"
aCtxt = 1000
If team = 0 Then
risp = MsgBox("Devi selezionare almeno una Branch", vbCritical, "Estratto Conto Leader", aHelp, aCtxt)
Exit Sub
End If
'*****controllo se è stato scelto un team o meno*******************

For I = 1 To team
Range("I4").Select
ActiveCell = "=INDIRECT(""tab!""&ADDRESS(" & tec & ",1))"
DAA = Range("I4")
ActiveSheet.PivotTables("Tabella_pivot1").PivotFields("Tecnico").CurrentPage = _
DDA
StampaPdf
tec = tec + 1
Next I


'messaggio del file creato
Dim lem, Style, Title, Help, Ctxt, Response, MyString
Style = vbOKOnly + vbInformation + vbApplicationModal
Title = "Estratto Conto Tecnici Leader - Rentokil Initial Italia S.p.A."
Help = "DEMO.HLP"
Ctxt = 1000

lem = lem & "Salvataggio completato " & vbLf & vbLf
lem = lem & "i file sono stati creati" & vbLf
lem = lem & "" & vbLf
lem = lem & "li troverai nel tuo path predefinito " & vbLf & vbLf
lem = lem & DefPath & vbLf & vbLf
lem = lem & "Ora puoi inviarli a chi di competenza " & vbLf

Response = MsgBox(lem, Style, Title, Help, Ctxt)

ActiveSheet.PivotTables("Tabella_pivot1").PivotFields("Tecnico").CurrentPage = _
"(Tutto)"
'Range("I4").Delete

End Sub

pare che va...ma non so perchè ogni tanto mi va in errore dentro al for quando do quel DDA al campo tecnico

"impossibile trovare la proprietà PivotFields per la classe PivotTable

oppure altre volte non mi prende il nome del tecnico perchè pare sia blanc per cui mi sovrascrive il file e mi trovo solo l'ultimo...
faccio altre prove.
ciao
ale
0 new messages