ho questa macro a cui dovrei fare un paio di modifiche:
Codice: Seleziona tutto
Sub Email
Dim collezione As New Collection
Sh = ThisComponent.Sheets.getByName("Foglio1")
c = Sh.createCursor
c.gotoEndOfUsedArea(false)
LastRow = c.RangeAddress.EndRow
Lista() = Sh.getCellRangeByName("Q2:Q" & LastRow + 1).GetDataArray
For i = 0 To Ubound(Lista)
codice = Split(Lista(i)(0), ", ")
On Error Resume Next
For n = 0 To Ubound(codice)
Verifica:
cod1 = Instr(codice(n),"@") : cod2 = Instr(codice(n),".")
If cod1 > 0 And cod2 > 0 Then
collezione.Add(codice(n), CStr(Codice(n)))
Else
codice(n) = InputBox ("Verificare esattezza indirizzo email: ","Verifica",codice(n) )
Goto Verifica
End if
Next n
Next i
On Error Goto 0
oDoc = StarDesktop.loadComponentFromURL( "private:factory/scalc", "_blank", 0, Array() )
Sh2 = oDoc.Sheets.getByName("Foglio1")
Sh2.getCellByPosition(0, x).String = "e-mail"
For x = 1 To collezione.Count
Sh2.getCellByPosition(0, x).String = collezione(x)
Dati = Split(collezione(x), "@")
Dati2 = Split(collezione(x), ".")
Sh2.getCellByPosition(1, x).String = Dati(0)
Sh2.getCellByPosition(2, x).String = Dati(1)
Sh2.getCellByPosition(3, x).String = Dati2(Ubound(Dati2))
Next x
c = Sh2.createCursor
c.gotoEndOfUsedArea(false)
LastRow = c.RangeAddress.EndRow
Dim OrdineCampi(2) As New com.sun.star.table.TableSortField
Dim mDescriptorOrden()
Range = Sh2.getCellRangeByPosition(0, 1, 3, LastRow)
mDescriptorOrden = Range.createSortDescriptor()
OrdineCampi(0).Field = 2
OrdineCampi(0).IsAscending = True
OrdineCampi(0).IsCaseSensitive = False
OrdineCampi(0).FieldType = com.sun.star.table.TableSortFieldType.AUTOMATIC
OrdineCampi(1).Field = 3
OrdineCampi(1).IsAscending = True
OrdineCampi(1).IsCaseSensitive = False
OrdineCampi(1).FieldType = com.sun.star.table.TableSortFieldType.AUTOMATIC
OrdineCampi(2).Field = 1
OrdineCampi(2).IsAscending = True
OrdineCampi(2).IsCaseSensitive = False
OrdineCampi(2).FieldType = com.sun.star.table.TableSortFieldType.AUTOMATIC
mDescriptorOrden(1).Name = "ContainsHeader"
mDescriptorOrden(1).Value = False
mDescriptorOrden(3).Name = "SortFields"
mDescriptorOrden(3).Value = OrdineCampi
Range.sort( mDescriptorOrden )
Sh2.getCellRangeByPosition(1, 1, 3, LastRow).ClearContents(1023)
Dim prop()
adressDoc = convertToURL("p:\email.xls") '<<<<<< da modificare
oDoc.storeAsURL(adressDoc, prop() )
oDoc.close(true)
End Sub
2) spostare nel secondo file le mail dalla colonna A alla colonna B
3) dal file iniziale oltre a copiare gli indirizzi mail avrei bisogno che mi prendesse altre informazioni che sono nelle colonne A & D e le mettesse in una unica colonna la A che però rimangano sempre collegate al campo mail che è la colonna Q anche nel caso di più mail nella stessa riga in questo caso dovrebbe ricreare due righe con le due mail ma le stesse informazioni prese da A & D una riga collegata alla prima mail e una riga collegata alla seconda mail
3) modificare l'ordinamento che adesso viene fatto in base alla casella mail ma con queste modifiche vorrei venga fatto in base alla colonna A del secondo file che appunto andrebbe a contenere i dati delle colonne A & D del primo file
spero di essermi spiegato bene