den nachfolgenden Code erhielt ich vor geraumer Zeit hier aus dem Forum. Er läuft soweit auch wunderbar. Durch eine Programmänderung ergibt sich jetzt die Möglichkeit, gleichzeitig noch vorhandene Telefonnummern in die Zwischenablage zu kopieren. Im UF sollten diese, sofern realisierbar, in Textbox7 sowie TextBox8 erscheinen.
Bisher ging es in den Textboxes 1-6 um Adressdaten im folgenden Format:
Frau Müller, Maria
Berliner Weg 35
1200 Musterstadt
ließe sich der Code ergänzen, um nun die Telefonnummern noch erscheinen zu lassen?
Format:
+49 (2731) 12345
(Privat/ Dienstlich)
+49 (177) 456789
(Privat/ Dienstlich)
Hier wäre schön, wenn anstatt +49 direkt eine 0 vorangestellt würde und die Leerzeichen sowie die Klammerzeichen dazwischen gelöscht werden, so dass die Telefonnummer direkt der Reihe nach erscheint. Weiterhin soll das (Privat/Dienstlich) sowie Telefon/Skype Icon nicht übernommen werden.
Herzlichen Dank schon jetzt für die Rückmeldungen!
Viele Grüße - Wolfgang
Private Sub CommandButton1_Click()
Dim strText As String
Dim avntValues As Variant, vntItem As Variant
Dim ialngIndex As Long, lngIndex As Long
Dim objClipBoard As DataObject
On Error Resume Next 'Abfangen, wenn Zwischenablage leer
Set objClipBoard = New DataObject
Call objClipBoard.GetFromClipboard
strText = objClipBoard.GetText
Set objClipBoard = Nothing
avntValues = Split(strText, vbCrLf)
TextBox1.Text = Split(avntValues(2), " ")(0)
For Each vntItem In Split(avntValues(2), " ")
If Right$(vntItem, 1) = "," Then Exit For
lngIndex = lngIndex + 1
Next
For ialngIndex = 1 To lngIndex
TextBox2.Text = TextBox2.Text & Split(avntValues(2), " ")(ialngIndex) & " "
Next
TextBox2.Text = Replace$(TextBox2.Text, ",", vbNullString)
TextBox2.Text = Trim$(TextBox2.Text)
For ialngIndex = lngIndex + 1 To UBound(Split(avntValues(2), " "))
TextBox3.Text = TextBox3.Text & Split(avntValues(2), " ")(ialngIndex) & " "
Next
TextBox3.Text = Trim$(TextBox3.Text)
TextBox4.Text = avntValues(6)
TextBox5.Text = Split(avntValues(10), " ")(0)
For ialngIndex = 1 To UBound(Split(avntValues(10), " "))
TextBox6.Text = TextBox6.Text & Split(avntValues(10), " ")(ialngIndex) & " "
Next
TextBox6.Text = Trim$(TextBox6.Text)
End Sub