Estrazione stringa alfanumerica da cella

[gnappo982-2]

#11112

Ciao a tutti, penso non ci siano formule che riescano a fare quello che a me serve.

ho una macro che mi importa in excel le mail di una data cartella di Outlook; di solito nelle celle relative all’oggetto della mail ho un testo simile a questo “RE: Field Service Report for Ticket 092092RE1454825” ma potrebbe anche variare. A me servirebbe avere solamente il “092xxxYYxxxxxxx”.

Quindi quello che mi servirebbe è:

guarda nella colonna “F” (oggetto mail)

cerca la stringa di 15 caratteri che inizia per 092 e copiala nella colonna “I”

 

allego il codice della macro, grazie a chi proverà a darmi una mano.

Option Explicit

 

Sub Button1_Click()

Dim olApp As Object, myfolder As Object

Dim oEmail As Object

Dim exists As Range, ri As Long, cnt As Long

 

‘crea un riferimento all’applicazione Outlook

Set olApp = CreateObject(“Outlook.Application”)

 

‘crea un riferimento alla cartella Posta in arrivo

‘per leggere il contenuto di una sottocartella rispetto a Posta in arrivo:

Set myfolder = olApp.GetNamespace(“MAPI”).GetDefaultFolder(6).Folders(“test”)        ‘ 6 = olFolderInbox

 

‘contatore per accodare a dati esistenti sul foglio

ri = [COUNTA(A:A)]

If ri = 0 Then ri = 2 Else ri = ri + 1      ‘tappo di sicurezza necessario per il caso della prima esecuzione

 

Application.ScreenUpdating = False          ‘non visualizza l’elaborazione in diretta, velocizza così l’esecuzione

 

‘scansione delle mail dalla cartella Outlook specirficata all’inizio

‘recupera i diversi dati e li infila cella per cella nel foglio

‘la riga 1 del foglio contiene la riga di intestazione delle colonne

‘ENTRY ID, CARTELLA, MITTENTE, DATA, OGGETTO, CORPO, ALLEGATI

 

For Each oEmail In myfolder.items

With oEmail

Set exists = Range(“A:A”).Find(.EntryID)    ‘cerca l’ID univoco della mail (generato da Outlook) per evitare di ricopiare doppioni

If exists Is Nothing Then

‘Cells(ri, “A”) = .EntryID         ‘entryID

‘Cells(ri, “B”) = .Parent          ‘cartella outlook

Cells(ri, “C”) = .SenderName      ‘mittente

Cells(ri, “D”) = .ReceivedTime    ‘data dell’email

Cells(ri, “E”) = .To       ‘destinatario

Cells(ri, “F”) = .Subject         ‘oggetto

Cells(ri, “G”) = .Body            ‘corpo del messaggio

Cells(ri, “H”) = .Attachments.Count        ‘numero di allegati

 

Rows(ri).WrapText = False

ri = ri + 1

cnt = cnt + 1

End If

End With

Next

 

Set myfolder = Nothing

Set olApp = Nothing

Application.ScreenUpdating = True

 

MsgBox “Finito. Ho importato ” & cnt & ” elementi.”

End Sub

 

 
<table style=”border-collapse: collapse; width: 260pt;” border=”0″ width=”346″ cellspacing=”0″ cellpadding=”0″>
<tbody>
<tr style=”height: 15.0pt;”>
<td style=”height: 15.0pt; width: 260pt;” width=”346″ height=”20″></td>
</tr>
</tbody>
</table>
<table style=”border-collapse: collapse; width: 260pt;” border=”0″ width=”346″ cellspacing=”0″ cellpadding=”0″>
<tbody>
<tr style=”height: 15.0pt;”>
<td style=”height: 15.0pt; width: 260pt;” width=”346″ height=”20″></td>
</tr>
</tbody>
</table>
 

[BySalv]

#11114

Ciao Gnappo ecco il file con la soluzione, questa la macro per l’estrazione

Sub estraz()
Dim r, c, x, y, d, k, t

t = Cells(1, 4)
For x = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    d = Cells(x, 1)
    If d Like "*" & t & "*" Then
        For y = 1 To Len(d)
            If Mid(d, y, 1) = "0" Then
                k = Mid(d, y, y + 15)
                Cells(x, 2) = k
                Exit For
            End If
        Next y
    End If
Next x
End Sub

volevo fare la ricerca si 092 ma vedi che 092 si ripete nella stringa, per cui ho inserito una cella spia per la scelta dei caratteri da cercare non ho scelto solo 0 ma potrei anche farlo sapendo a priori che prima di 092 non ci sia un altro 0zero, altrimenti estrarrebbe i 15 caratteri partendo da quel 0zero.

adattalo al tuo codice

il link al file
http://www.filedropper.com/gnappo_4

Ciao By sal (8-D

Ciao By Sal (8-)
se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie

[gnappo982-2]

#11117

Grazie BySal, funziona alla perfezione.

mi daresti una dritta sulla linea di codice che ho copiato non so dove relativa alla cartella di outlook dove andare a cercare le mail.

‘crea un riferimento alla cartella Posta in arrivo
‘per leggere il contenuto di una sottocartella rispetto a Posta in arrivo:
Set myfolder = olApp.GetNamespace(“MAPI”).GetDefaultFolder(6).Folders(“test”) ‘ 6 = olFolderInbox

mi funziona per tutte le sottocartelle che si trovano sotto Posta in arrivo, ma la mia è allo stesso livello di posta in arrivo. In pratica dovrei sostituire il numero 6 con il numero della mia cartella, ma non ho idea di come trovarlo.

 

[BySalv]

#11118

Ciao io non uso Outlook, ma eccoti un elenco dei codici per le cartelle

Nomi cartella predefiniti
Di seguito sono riportati i nomi delle cartelle predefinite da utilizzare quando si fa riferimento alle cartelle predefinite di Outlook.

Nome	Valore	Descrizione
olFolderCalendar	9	Cartella del calendario
olFolderContacts	10	Cartella dei contatti
olFolderDeletedItems	3	Cartella Posta eliminata
olFolderDrafts	16	Cartella bozze
olFolderInbox	6	Cartella Posta in arrivo
olFolderJournal	11	Cartella journal
olFolderJunk	23	Cartella posta indesiderata
olFolderNotes	12	Cartella delle note
olFolderOutbox	4	Cartella Posta in uscita
olFolderSentMail	5	Cartella Posta inviata
olFolderSuggestedContacts	30	Cartella dei contatti suggeriti
olFolderTasks	13	Cartella delle attività
olFolderToDo	28	Cartella To Do
olPublicFoldersAllPublicFolders	18	Cartella Tutte le cartelle pubbliche nell'archivio delle cartelle pubbliche di Exchange (solo Exchange)
olFolderRssFeeds	25	Cartella Feed RSS

come vedi la 6 è la cartella della posta in arrivo, vedi se può esserti utile

ma comunque credo che in “MyFolder” dovrebbe esserci la tua cartella

Ciao By sal (8-D

Ciao By Sal (8-)
se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie

[Autore]

Post