1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415
| ' VB-Script Groupwise-Import-Aufbereitung
'
' written by Norbert Anreiter - FREEWARE!
'
' Input-File: CSV-file (1st line = headline, will be ignored!)
' all other records are treated to be User-records
' neither contacts nor group are accepted.
' Output-File: Groupwise-import-file
'
' ***** start of global declarations - for internationalization - ENGLISH VERSION is standard, even if no INI-file exists!
dontuse = "not usable" ' not usable entries from input-file (will be ignored)
example = "e.g:" ' ... for example: ...
allfiles = "All files" ' for open-message of input-file
usercancel = "Cancel by user-request" ' user requested cancel of process or IE was closed
okmsg = "Processing terminated" ' tell user End of process
separatorerror = "Seperator within this file couldn't be found!" & vbCrlf & _
"Please help me! Which seperator-sign should be used?"
' separator-value not recognized - learn from user after this message
msgdup = "erroneous parameter: duplicate use: "
' if no NAB-file is found, defaultheader will be used for GW-entries
' texts are selectable in option-field for each parameter
defaultheader = ":::TAGMAP:::0FFE0003:***,3001001E:Name,3A08001E:Office Phone Number," & _
"3A18001E:Department,3A23001E:Fax Number,3003001E:E-Mail Address," & _
"3A06001E:First Name,3A11001E:Last Name,3A17001E:Title,3A29001E:Address," & _
"3A27001E:City,3A28001E:State,3A26001E:Country,3A2A001E:ZIP Code,3002001E:E-Mail Type," & _
"3A19001E:Mailstop,3A09001E:Home Phone Number,3A1C001E:Cellular Phone Number," & _
"3A21001E:Pager Number,3A1A001E:Phone Number,600B001E:Greeting,600F001E:Owner," & _
"3A16001E:Organization,3004001E:Comments,3A00001E:User ID,6604001E:Domain," & _
"6609001E:Additional Routing,6605001E:Post Office,6603001E:GUID,6616001E:Preferred E-Mail Address," & _
"6607001E:eDirectory Distinguished Name,6608001E:Network ID,660D001E:Internet Domain," & _
"660E001E:AIM/IM Screen Name,3A45001E:Prefix,3A44001E:Middle Name," & _
"3A05001E:Generation,3A5D001E:Home Address,3A59001E:Home City,3A5C001E:Home State," & _
"3A5B001E:Home ZIP,3A5A001E:Home Country,3A50001E:Personal Web Site,3A51001E:Office Web Site," & _
"6612001E:Resource Type,6615001E:Primary Contact Name,8000001E:additional field"
' ****** end of global declarations - no more changes required below this position ******
myscript = wscript.scriptfullname
mypath = LEFT(myscript, instrrev(myscript, "\"))
maxseq = 5 ' maximum sequence-Numbers per entry
set WS = wscript.createobject ("WScript.Shell")
set FSO = Wscript.createobject ("Scripting.FileSystemObject")
' ****** get initial values
if fso.fileexists (left(myscript, len(myscript) - 3) & "INI") then
set infile = FSO.opentextfile(left(myscript, len(myscript) - 3) & "INI") ' get INI-values
while (infile.atendofstream = false) ' default is ENGLISH
inpline = infile.readline ' which will be used
if instr(inpline, "=") > 0 then ' if no INI file present
select case lcase(trim(left(inpline, instr(inpline, "=") - 1)))
case "maxseq"
maxseq = trim(mid(inpline, instr(inpline, "=") + 1)) + 0
case "headline"
htmlheadline = trim(mid(inpline, instr(inpline, "=") + 1))
case "dontuse"
dontuse = trim(mid(inpline, instr(inpline, "=") + 1))
case "example"
example = trim(mid(inpline, instr(inpline, "=") + 1))
case "allfiles"
allfiles = trim(mid(inpline, instr(inpline, "=") + 1))
case "usercancel"
usercancel = trim(mid(inpline, instr(inpline, "=") + 1))
case "okmsg"
okmsg = trim(mid(inpline, instr(inpline, "=") + 1))
case "separatorerror"
separatorerror = trim(mid(inpline, instr(inpline, "=") + 1))
case "msgdup"
msgdup = trim(mid(inpline, instr(inpline, "=") + 1))
case "defaultheader"
defaultheader = trim(mid(inpline, instr(inpline, "=") + 1))
case "ignorenabfile"
if ucase(left(trim(mid(inpline, instr(inpline, "=") + 1)), 3)) = "YES"then
ignorenabfile = 1
end if
case else
' ignore this parameter - not important for script - maybe comment?
end select
end if
wend
end if
set folder = FSO.getfolder(WS.Specialfolders("MyDocuments"))
if ignorenabfile = 0 then
set filesinfolder = folder.files
for each item in filesinfolder
if ucase(right(item.name, 3)) = "NAB" then
filename = item.name
end if
next
end if
if filename = "" then ' no NAB-file found in directory: default-headline to be used!
headline = defaultheader
else
set infile = fso.opentextfile(WS.Specialfolders("MyDocuments") & "\" & filename)
headline = infile.readline
infile.close
set infile = nothing
end if
firstname = mid(headline, instr(headline, "3A06001E:"))
firstname = left (firstname, instr(firstname, ",") - 1)
lastname = mid(headline, instr(headline, "3A11001E:"))
lastname = left(lastname, instr(lastname, ",") - 1)
dim param
param = Split (headline, ",")
anzparams = UBound(param)
on error resume next
set callparameter = WScript.Arguments
if callparameter.Count >= 1 then
' this is my filename
dlgfilename = callparameter.Item(0)
else
err.clear
Set objDialog = CreateObject("UserAccounts.CommonDialog") ' XP upwards only
if err <> 0 then
msgbox "Sorry - cannot initialize file-open dialog. Please use ""gwimp filename"""
wscript.quit
end if
objDialog.Filter = "CSV Dateien (*.CSV)|*.csv|" & allfiles & "|*.*"
objDialog.Flags = &H800 ' file must exist!
objDialog.FilterIndex = 1 ' default: *.CSV-files
objDialog.InitialDir = ws.specialfolders("MyDocuments")
intResult = objDialog.ShowOpen
dlgfilename = objdialog.filename
If dlgfilename = "" Then ' user cancelled the Open-file-dialog
Wscript.Quit
End if
end if
set infile = fso.opentextfile(dlgfilename)
inzeile = infile.readline
if instr(inzeile, ",") > 0 then
trennzeichen = ","
elseif instr(inzeile, ";") > 0 then
trennzeichen = ";"
else
trennzeichen = inputbox (separatorerror)
end if
trennzeichen = left(trennzeichen & " ", 1)
dim inparamhead
inparamhead = Split(inzeile, trennzeichen)
maxinparam = ubound(inparamhead)
dim inparam
redim infileparam (maxinparam)
while (fillparam <= maxinparam AND infile.AtEndOfStream = false)
redim inparam (maxinparam)
inparam = Split(infile.readline, trennzeichen)
fillparam = maxinparam + 1 ' terminate
for i = lbound(infileparam) to ubound(infileparam)
if i <= ubound(inparam) and i >= lbound(inparam) then
if infileparam(i) = "" then ' no value set
fillparam = i ' continue while
end if
if inparam(i) <> "" then ' value set
infileparam(i) = inparam(i)
end if
end if
next
wend
infile.close
set infile = nothing
inparam = Split(inzeile, trennzeichen) ' re-initialize header-line
inputparams = ubound(inparam)
set oIE = WScript.CreateObject("InternetExplorer.Application")
oIE.navigate "about:blank"
oIE.visible = 1
oIE.addressbar = 1 ' 0
oIE.statusbar = 1
Do While (oIE.Busy): Loop
if FSO.fileexists (left(dlgfilename, len(dlgfilename) - 3) & "STR") then
' import already run - get old selections
set strfile = fso.opentextfile(left(dlgfilename, len(dlgfilename) - 3) & "STR")
infilestrg = strfile.readline
if err = 0 then
oldparams = split(infilestrg, ",")
end if
end if
set doc1 = oIE.document ' write the html- and VBS-code to the (open) document
doc1.writeln "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtmll/DTD/xhtmll-transitional.dtd"">"
doc1.writeln "<HTML xmlns=""http://www.w3.org/1999/xhtml""><head>"
doc1.writeln "<title>GWIMP - Groupwise Importfunktion</title></head>"
doc1.writeln "<script language=""VBSCRIPT"">"
doc1.writeln "<!--" & vbCrlf & "Dim ready" & vbCrlf & "ready = ""0""" & vbCrlf & "public GWIMP_form"
doc1.writeln "Function CheckVal" & vbCrlf & " CheckVal = ready" & vbCrlf & "End Function"
doc1.writeln "Public Function getparamval (parmnr)" & vbCrlf & " select case parmnr"
for j = 0 to inputparams
if infileparam(j) <> "" then
doc1.writeln " Case " & j & vbCrlf & _
"getparamval = Document.header.param" & j & ".value & "":"" & " & "Document.header.param" & j & _
".options(Document.header.param" & j & ".selectedindex).text"
end if
next
doc1.writeln " End Select" & vbCrlf & "End Function"
doc1.writeln "Public Function setselection (parmnr, val1, val2)" & vbCrlf & " select case parmnr"
for j = 0 to inputparams
if infileparam(j) <> "" then
doc1.writeln " Case " & j & vbCrlf & _
"Document.header.param" & j & ".selectedindex = val1" & vbCrlf & _
"Document.header.seq" & j & ".selectindex = val2" & vbCrlf
end if
next
doc1.writeln " End Select" & vbCrlf & "End Function"
doc1.writeln "Public Function getval (parmnr)" & vbCrlf & " select case parmnr"
for j = 0 to inputparams
if infileparam(j) <> "" then
doc1.writeln " Case " & j & vbCrlf & _
"getval = Document.header.param" & j & ".selectedindex"
end if
next
doc1.writeln " End Select" & vbCrlf & "End Function"
doc1.writeln "Public Function getseq (parmnr)" & vbCrlf & " select case parmnr"
for j = 0 to inputparams
if infileparam(j) <> "" then
doc1.writeln " Case " & j & vbCrlf & _
"getseq = Document.header.seq" & j & ".selectedindex"
end if
next
doc1.writeln " End Select" & vbCrlf & "End Function"
doc1.writeln "Sub Window_OnQuit ()" & vbCrlf & " ready = ""999999""" & vbCrlf & "End Sub"
doc1.writeln "Sub ResetReady" & vbCrlf & " ready = ""0""" & vbCrlf & "End Sub"
doc1.writeln "Sub OK_OnClick" & vbCrlf & " ready = ""1""" & vbCrlf & "End Sub" & vbCrlf & "'-->" & vbCrlf & "</script>"
doc1.writeln "<body bgcolor=""#FFFF99""> <FONT FACE=""Verdana""><size=11>" & vbCrlf & "<form name=""header"">" & vbCrlf
doc1.writeln "<h1><center>" & htmlheadline & "</center></h1>"
err.clear ' reset err-code to 0
on error resume next ' no more error-handling
if ubound(oldparams) < inputparams then: end if ' "ubound" failed! - set err-code to anything other than 0
if err <> 0 then ' old params are no area - not yet set (1st call)!
redim oldparams(inputparams * 2)
for i = 0 to ubound(oldparams)
oldparams(i) = -1 ' initialize default with -1-selection
next
end if
on error goto 0 ' normal error-processing
for j = 0 to inputparams
if infileparam(j) <> "" then
doc1.writeln "<b>Parameter "
if j < 10 then
doc1.writeln " "
end if
selmyval = 0
doc1.writeln j & ": </b>"
doc1.writeln "<select name=""param" & j & """>"
doc1.write "<option value=""0"""
if oldparams(j * 2) = "" then
oldparams(j * 2) = 0
else
if oldparams(j * 2) + 0 < 1 then: doc1.write " selected ": end if
end if
doc1.writeln ">" & dontuse & "</option>"
for i = 1 to anzparams
doc1.write "<option value=""" & left(param(i), instr(param(i), ":") - 1) & """"
if oldparams(j*2) + 0 = i then
if selmyval = 0 then: doc1.write " selected ": selmyval = 1: end if
elseif param(i) = inparam(j) then
if selmyval = 0 then: doc1.write " selected ": selmyval = 1: end if
end if
doc1.writeln ">" & mid(param(i), instr(param(i), ":") + 1) & "</option>"
next
doc1.writeln "</select> Pos: <select name=""seq" & j & """> & nbsp;"
selmyval = 0
for i = 1 to maxseq
doc1.write "<option value=""" & i & """"
if j > 0 and ubound (oldparams) >= j * 2 + 1then
if oldparams(j * 2 + 1) <> "" then
if oldparams(j * 2 + 1) + 1 = i then
if selmyval = 0 then: doc1.write " selected ": selmyval = 1: end if
end if
end if
end if
doc1.writeln ">" & i & "</option>"
next
doc1.write "</select> <FONT FACE=""Courier""><size=8> " & inparamhead(j)
for ii = len(trim(inparamhead(j))) to 15: doc1.write ".": next
doc1.write " " & example & left(infileparam(j), 30) & "<br /> <FONT FACE=""Verdana""><size=11>"
end if
next
doc1.writeln "<button name=""OK"" type=""button"" OnClick=""OK_OnClick"" value=""OK""> OK </button></head>"
doc1.writeln "</form></body></html>"
set docscr = oIE.Document.Script
do ' present IE-screen and get input from user
on error resume next ' don't display error when IE was closed
call oIE.Document.script.ResetReady
do
dummy = DoEvents ' do NOT lock-up machine
loop while (oIE.Document.script.CheckVal = "0" AND err = 0) ' not OK pressed, IE-screen opened
if err <> 0 then ' IE closed by user?
wscript.quit ' no input available - end routine!
end if
if oIE.Document.script.Checkval = "0" then ' OK not pressed!
msgbox (usercancel)
wscript.quit ' should not occur
end if
on error goto 0
msg = ""
buffertest = ""
for j = 0 to inputparams ' test input-parameters for duplicates
if instr(buffertest, "*" & oie.document.script.getval(j) & "," & oie.document.script.getseq(j)) > 0 _
AND oie.document.script.getval(j) > 0 then ' valid selection? != dontuse!
msg = msg & msgdup & oie.document.script.getparamval(j) & vbCrlf ' duplicate found! = error!
else
buffertest = buffertest & "*" & oie.document.script.getval(j) & "," & oie.document.script.getseq(j)
end if
next
if msg <> "" then ' duplicate entries found!
msgbox (msg) ' show message to user
end if
loop while (msg <> "") ' messages occred, so continue with loop
buffertest = "" ' clear test-buffer
ausparams = split(defaultheader, ",")
defaultheader = ""
maxparams = ubound(ausparams) + 0
redim sequout (maxparams, maxseq)
for i = 1 to maxparams: for j = 1 to maxseq: sequout(i,j) = "": next: next
bufferselfile = ""
on error resume next
for j = 0 to inputparams ' get input-parameters for output
err.reset
bufferselfile = bufferselfile & oie.document.script.getval(j) & "," & oie.document.script.getseq(j) & ","
if oie.document.script.getval(j) > 0 then
selseq = oie.document.script.getseq(j) + 1
selval = oie.document.script.getval(j) + 0
if selval > 0 then: sequout (selval, selseq) = j: end if
end if
next
on error goto 0
ausheader = ausparams(0) & "," & ausparams(1)
for j = 2 to maxparams
if sequout (j, 1) <> "" then
ausheader = ausheader & "," & ausparams(j)
end if
next
redim ausparams (ubound(inparam))
redim namedef (2)
if sequout(1, 1) = "" then ' no value for (Display)-"Name" found
sequout(1, 1) = sequout(7, 1) ' default to: lastname and
sequout(1, 2) = sequout(6, 1) ' firstname
end if
set outfile = fso.createtextfile(left(dlgfilename, len(dlgfilename) - 3) & "NAB", true)
set infile1 = fso.opentextfile(dlgfilename)
inzeile1 = infile1.readline ' ignore 1st line (should be header-line) from CSV-file
inparam = Split(inzeile, trennzeichen)
outfile.writeline ausheader ' write header-line to NAB-file
ausheader = ""
on error goto 0
while (infile1.AtEndOfStream = false)
redim inparam (Ubound(ausparams))
inparam = Split(infile1.readline, trennzeichen)
auszeile = """U"","
for j = 1 to maxparams ' inputparams
if sequout(j, 1) <> "" then
if inparam(sequout(j, 1)) <> "" then
auszeile = auszeile & """"
for k = 1 to maxseq
if sequout(j, k) <> "" then
if k > 1 AND k < maxseq AND trim(inparam(sequout(j, k))) <> "" then
auszeile = auszeile & " "
end if
auszeile = auszeile & trim(inparam(sequout(j, k)))
end if
next
auszeile = auszeile & """"
end if
auszeile = auszeile & ","
end if
next
if right (auszeile, 1) = "," then: auszeile = left(auszeile, len(auszeile) - 1): end if
outfile.writeline (auszeile) ' write data to NAB-file
wend
infile1.close
set infile1 = nothing
outfile.close
set outfile = nothing
set outfile = fso.createtextfile(left(dlgfilename, len(dlgfilename) - 3) & "STR", true)
outfile.writeline (bufferselfile) ' write selections to STR-file (for re-use)
outfile.close
set outfile = nothing
oIE.Quit ' destroy internet-exploder-window
set oIE= Nothing
msgbox okmsg ' show user message that the routine terminated |
Partager