Crea file Txt

Ciao,

questa macro mi crea una stringa di indirizzi Mail, pero c'è un problema nell' elenco ci sono parecchie Mail che si ripetono, è possibile rendere la stringa univoca
 
Public Sub Mail()


    Dim s As String
    Dim i As Integer
    Dim FileNum As Integer
    Dim nr As Long


    If "C:\Mail.txt" <> "" Then
        Kill "C:\Mail.txt"
    End If


    FileNum = FreeFile


        With Worksheets("Elenco F.M.I.")


            nr = .Range("A65536").End(xlUp).Row


            For i = 1 To nr
                s = s & .Cells(i, 17).Value & " "
            Next


        End With


    Open "C:\Mail.txt" For Append As #FileNum
    Print #FileNum, s
    Close #FileNum


End Sub

Grazie
Ciao
Roccia
 

Informazioni domanda


Ultimo aggiornamento febbraio 27, 2018 Visualizzazioni 116 Si applica a:
Risposta
               

La stringa che devo creare è una lista di indirizzi Mail per utilizzare come indirizzo delle Mail da spedire

Il problema è che nella lista ci sono tanti doppioni, vorrei evitare di mandare una decina di Mail alla stessa persona.

 

 

Ho capito male io... ;-)

 

Due strade:

  1. filtri la lista
  2. metti gli indirizzi in modo univoco in una Collection e ne sfrutti l'eventuale errore per non inserire il contenuto della cella nella stringa.

Per il punto 2, prova:

 

Public Sub Mail()
 
     Dim s As String
     Dim i As Long
     Dim FileNum As Integer
     Dim nr As Long
     Dim lng As Long
     Dim col As Collection
 
     If "C:\Mail.txt" <> "" Then
         Kill "C:\Mail.txt"
     End If
    
     Set col = New Collection
    
    FileNum = FreeFile
 
         With Worksheets("Elenco F.M.I.")
             nr = .Range("A" & .Rows.Count).End(xlUp).Row
             For i = 1 To nr
                On Error Resume Next
                col.Add CStr(.Cells(i, 17).Value), CStr(.Cells(i, 17).Value)
                If Err.Number = 0 Then
                    s = s & .Cells(i, 17).Value & " "
                Else
                    Err.Number = 0
                End If
             Next
         End With
 
     Open "C:\Mail.txt" For Append As #FileNum
 
     Print #FileNum, s
 
     Close #FileNum
    
     Set col = Nothing
 
 End Sub


Ho aggiunto qui il file che ho utilizzato per l'esempio. Per evitare i problemi di scrittura/eliminazione dei files che si trovano in disco C: in Windows7/8, ho utilizzato una Directory(Prova) per salvare il file di testo:

http://www.maurogsc.eu/esempiforum13/collectionmail.zip

--
Mauro Gamberini
Microsoft© MVP (Excel)
http://www.maurogsc.eu

Il problema è stato risolto?

Siamo spiacenti che questo non sia stato d'aiuto.

Fantastico! Grazie per aver scelto questa risposta.

Sei soddisfatto di questa risposta?

Grazie per il tuo commento, ci aiuta a migliorare il sito.

Sei soddisfatto di questa risposta?

Grazie per il tuo commento.