'v4.B*************************************************** 

' File:   2-5mal-input.vbs 

' Autor:  W.Schmelz 

'         http://source-center.de/forum/showthread.php?t=1738 

' 

'         http://dieseyer.de 

' 

' zerlegt / extrahiert aus der Eingabe in eine  

' InputBox mehrere Eingaben. 

'******************************************************* 

 

Option Explicit 

 

Dim Txt, Txt1, Txt2, Txt3, Txt4, Txt5 

Dim Laenge, Sym, i 

Dim Zahl1, Zahl2, Zahl3, Zahl4, Zahl5 

Dim Rechts, Rechts1, Rechts2, Rechts3, Rechts4, Rechts5 

Dim Links, Links1, Links2, Links3, Links4, Links5 

Dim Eingabe, Eingabe1, Eingabe2, Eingabe3, Eingabe4, Eingabe5 

 

Dim Titel : Titel =" Input - Box mit 2 bis 5 Einträgen " 

 

 

' Streichen oder Hinzufügen einer Schleife am Ende ändert Höchstzahl der Einträge ! 

' ************************************************ 

 

Txt=Txt&"Bitte mit Abtrennung durch # eintragen"&VbCRLF&VbCRLF 

Txt=Txt&"und dabei auf die Reihenfolge achten !"&VbCRLF&VbCRLF&VbCRLF 

Txt=Txt&"1) Die Pers. Nr. z. B. A 7770007700"&VbCRLF&VbCRLF 

Txt=Txt&"2) Die Telefonvorwahl z. B. 02374"&VbCRLF&VbCRLF 

Txt=Txt&"3) Die Telefon - Nr. z. B. 77777"&VbCRLF&VbCRLF 

Txt=Txt&"4) Name : Schulze - Bochum, Karl - Heinz"&VbCRLF&VbCRLF 

Txt=Txt&"4) und noch : . . . "&VbCRLF&VbCRLF&VbCRLF 

Txt=Txt&" Pers.Nr. # Vorwahl # Telefon # Name # Sonst " 

 

Sym="#" ' Trennsymbol " # " evtl. sinngemäß ändern! 

' ***************************************** 

 

Eingabe=InputBox (VbCRLF&Txt&VbCRLF,Titel,Eingabe) 

If Eingabe="" then WScript.Quit 

  If not (Right(Eingabe,1)=Sym) then Eingabe=Eingabe&Sym ' Falls Symbol rechts vergessen! 

  If Left(Eingabe,1)=Sym then Eingabe=Mid(Eingabe,2) ' Falls Symbol links! 

Eingabe1=Eingabe 

Laenge=Len(Eingabe1) 

 

' Die Eingabenfolge wird gemäß den " # " in Abschnitte zerlegt 

' und die Teile als Variablen " Txti " definiert 

 

Zahl1=0 

i=1 

Do until Rechts=Sym 

  Links=Left(Eingabe1,i) 

  Rechts=Right(Links,1) 

  i=i+1 

  Zahl1=Zahl1 +1 ' Zahl1 ist Länge der 1. Sequenz mit dem " # " 

Loop 

Txt1=Left(Links,Zahl1 -1) 

 

Eingabe2=Right(Eingabe1,Laenge-Zahl1) ' Neufestlegung 

  If Eingabe2="" then Ende 

Zahl2=0 

i=1 

Do until Rechts2=Sym 

  Links2=Left(Eingabe2,i) 

  Rechts2=Right(Links2,1) 

  i=i+1 

  Zahl2=Zahl2 +1 

Loop 

Txt2=Left(Links2,Zahl2 -1) 

 

Eingabe3=Right(Eingabe2,Laenge-Zahl1-Zahl2) 

If Eingabe3="" then Ende 

Zahl3=0 

i=1 

Do until Rechts3=Sym 

  Links3=Left(Eingabe3,i) 

  Rechts3=Right(Links3,1) 

  i=i+1 

  Zahl3=Zahl3 +1 

Loop 

Txt3=Left(Links3,Zahl3 -1) 

 

Eingabe4=Right(Eingabe3,Laenge-Zahl1-Zahl2-Zahl3) 

If Eingabe4="" then Ende 

Zahl4=0 

i=1 

Do until Rechts4=Sym 

  Links4=Left(Eingabe4,i) 

  Rechts4=Right(Links4,1) 

  i=i+1 

  Zahl4=Zahl4 +1 

Loop 

Txt4=Left(Links4,Zahl4 -1) 

 

Eingabe5=Right(Eingabe4,Laenge-Zahl1-Zahl2-Zahl3-Zahl4) 

If Eingabe5="" then Ende 

Zahl5=0 

i=1 

Do until Rechts5=Sym 

  Links5=Left(Eingabe5,i) 

  Rechts5=Right(Links5,1) 

  i=i+1 

  Zahl5=Zahl5 +1 

Loop 

Txt5=Left(Links5,Zahl5 -1) 

 

Ende ' Sub - Aufruf 

 

WScript.Quit 

 

 

'**************************************************************  

Sub Ende 

'**************************************************************  

 

' Kontrollmeldung: 

Txt=VbCRLF&VbCRLF 

Txt=Txt&"1) Die Pers. Nr. ist "& Txt1 &VbCRLF&VbCRLF 

Txt=Txt&"2) Die Telefonvorwahl ist "& Txt2 &VbCRLF&VbCRLF 

Txt=Txt&"3) Die Telefon - Nr. ist "& Txt3 &VbCRLF&VbCRLF 

Txt=Txt&"4) Name ist "& Txt4 &VbCRLF&VbCRLF 

Txt=Txt&"5) und noch ist "& Txt5 &VbCRLF&VbCRLF 

MsgBox Txt,,Titel 

 

End Sub ' Ende