autounattend xml file generation with vbs wsh

Hi,

This script will:
read 2 of 3 files:
SynchronousCommand01_maison.txt
SynchronousCommand02_job.txt
SynchronousCommand03_common.txt
and generate a 64 bits autounattend.xml file in same folder as the script

If config01 is equal to 1, common and job files will be used to generate the autounattend.xml
If config01 is equal to 2, common and maison files will be used.

The 3 input files should look like this (3 lines for each synchronous command)

===== SynchronousCommand03_common.txt ======
1
powershell permission remotesigned
reg add HKCU\Software\Microsoft\PowerShell\1\ShellIds\Microsoft.PowerShell\ /v ExecutionPolicy /t Reg_SZ /d "RemoteSigned" /f
3
7zip
cmd /c c:\_appsall\7zip\commandline.bat
1
explorer open in this PC
REG ADD "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced" /v LaunchTo /t REG_DWORD /d 1 /f
====== end of file ======

You can change in the script (with notepad) the value config01 to inrtegrate "maison" (config01 = 1) or job (config01 = 2)

It is for 64 bits only, but you can change it for 32 bits (x86) in an array (it used to generate the file for both, but i had an issue where the synchronous commands were executed twice in 64 bits.



'=== autounattend.vbs
'=== autounattend.xml file generator for windows 10 1703

'=== by sergefournier@hotmail.com 2017-06-20

'=== save thsi script as: csv2xml.VBS
'=== input file must be sample1.csv in the same directory as the script (same folder)
'=== outputfile will be sampleout1.xml
'=== zzz_troubleshooting.txt will tell you what was not processed (lines)

'=== support 2 carriage return in a field, but not 3 :P

Set objFSO    = CreateObject("Scripting.FileSystemObject")

'=== actual drive, actual directory, and "\"
thepath=WScript.ScriptFullName
p = instrRev(thepath,"\")
basedir  = left(thepath,p)
filnam = right(thepath,len(thepath)-p)

logall = 1

if logall=1 then
   '=== debug log
   logfile01 = basedir & filnam & "_log.txt"
   on error resume next
   Set Fil02 = objFSo.OpenTextFile(logfile01, 2, true)
   on error goto 0
end if

if logall=1 then
   fil02.WriteLine date & " " & time & " START"
end if

filenamefullxml02 = basedir & "autounattend.xml"
'=== 1 = maison
'=== 2 = job
config01 = 2

'=== spaces in xml name are not good

quebec01 = 1

if quebec01 = 0 then
UILanguage01 = "en-US"
InputLocale01 = "0426:00010426"
SystemLocale01 = UILanguage01
UILanguage02 = UILanguage01
UILanguageFallback01 = UILanguage01
UserLocale01 = UILanguage01
else
  '=== winpe and preload (france only)
UILanguage01 = "fr-FR"
InputLocale01 = "0c0c:00001009"
SystemLocale01 = UILanguage01
UILanguage02 = UILanguage01
UILanguageFallback01 = UILanguage01
UserLocale01 = "fr-CA"

  '=== windows 10
UILanguage11 = "fr-CA"
InputLocale11 = "0c0c:00001009"
SystemLocale11 = UILanguage11
UILanguage12 = UILanguage11
UILanguageFallback11 = UILanguage11
UserLocale11 = UILanguage11

end if

'=== userdate
if config01 = 1 then
'=== home
fullname01 = "Maison"
else
fullname01 = "Utilisateur"
end if

username01 = fullname01

organization01 = ""

productkey01 = "W269N-WFGWX-YVC9B-4J6C9-T83GX"
enablefirewall01 = "true"

  '1 Specifies the recommended level of protection for your computer.
  '2 Specifies that only updates are installed.
  '3 Specifies that automatic protection is disabled.
if config01 = 1 then
'=== home
NetworkLocation01 = "Home"
protectyourpc01 = "2"
else
NetworkLocation01 = "Work"
protectyourpc01 = "3"
end if

password01 = ""
'=== localaccount
description01 = "Utilisateuradmin"
displayname01 = fullname01
group01= "Administrators"
name01 = fullname01

RegisteredOrganization01 = ""
registredowner01 = ""

computername01 = ""

timezone01 = "Eastern Standard Time"

installfromtag01 = 1 '=== put install from to choose an image index in WIM
installtotag01 = 0 '=== put installto to choose disk 0 partition 0

archs01 = array("amd64") '=== architecture
'archs01 = array("x86", "amd64") '=== architecture

'=== create xml
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set objIntro = xmlDoc.createProcessingInstruction("xml","version='1.0' encoding='UTF-8'")
xmlDoc.insertBefore objIntro,xmlDoc.childNodes(0)

Set objxmlchild01 = xmlDoc.createElement("unattend")
objxmlchild01.SetAttribute "xmlns", "urn:schemas-microsoft-com:unattend"
xmlDoc.appendChild objxmlchild01

Set objxmlchild02 = xmlDoc.createElement("settings")
objxmlchild02.SetAttribute "pass", "windowsPE"
objxmlchild01.appendChild objxmlchild02
 
    '=== Microsoft-Windows-International-Core-WINPE
    for each arch01 in archs01
 
      Set objxmlchild03 = xmlDoc.createElement("component")
objxmlchild03.SetAttribute "name", "Microsoft-Windows-International-Core-WinPE"
objxmlchild03.SetAttribute "processorArchitecture", arch01
objxmlchild03.SetAttribute "publicKeyToken", "31bf3856ad364e35"
objxmlchild03.SetAttribute "language", "neutral"
objxmlchild03.SetAttribute "versionScope", "nonSxS"
objxmlchild03.SetAttribute "xmlns:wcm", "http://schemas.microsoft.com/WMIConfig/2002/State"
objxmlchild03.SetAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
objxmlchild02.appendChild objxmlchild03

Set objxmlchild04 = xmlDoc.createElement("SetupUILanguage")
objxmlchild03.appendChild objxmlchild04

'=== france setup cause canada does not exist in winpe
Set objxmlchild05 = xmlDoc.createElement("UILanguage")
objxmlchild05.text = UILanguage01
objxmlchild04.appendChild objxmlchild05

Set objxmlchild04 = xmlDoc.createElement("InputLocale")
objxmlchild04.text = InputLocale01
objxmlchild03.appendChild objxmlchild04

Set objxmlchild04 = xmlDoc.createElement("SystemLocale")
objxmlchild04.text = SystemLocale01
objxmlchild03.appendChild objxmlchild04
Set objxmlchild04 = xmlDoc.createElement("UILanguage")
objxmlchild04.text = UILanguage02
objxmlchild03.appendChild objxmlchild04
Set objxmlchild04 = xmlDoc.createElement("UILanguageFallback")
objxmlchild04.text = UILanguageFallback01
objxmlchild03.appendChild objxmlchild04
Set objxmlchild04 = xmlDoc.createElement("UserLocale")
objxmlchild04.text = UserLocale01
objxmlchild03.appendChild objxmlchild04

    next

'===Microsoft-Windows-Setup
for each arch01 in archs01
Set objxmlchild03 = xmlDoc.createElement("component")
objxmlchild03.SetAttribute "name", "Microsoft-Windows-Setup"
objxmlchild03.SetAttribute "processorArchitecture", arch01
objxmlchild03.SetAttribute "publicKeyToken", "31bf3856ad364e35"
objxmlchild03.SetAttribute "language", "neutral"
objxmlchild03.SetAttribute "versionScope", "nonSxS"
objxmlchild03.SetAttribute "xmlns:wcm", "http://schemas.microsoft.com/WMIConfig/2002/State"
objxmlchild03.SetAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
objxmlchild02.appendChild objxmlchild03

         
Set objxmlchild04 = xmlDoc.createElement("ImageInstall")
objxmlchild03.appendChild objxmlchild04

Set objxmlchild05 = xmlDoc.createElement("OSImage")
objxmlchild04.appendChild objxmlchild05
         
            if installfromtag01 = 1 then
         
            '=== choose image in index1 in dvd (wim index)
Set objxmlchild06 = xmlDoc.createElement("InstallFrom")
objxmlchild05.appendChild objxmlchild06

Set objxmlchild07 = xmlDoc.createElement("MetaData")
objxmlchild07.SetAttribute "wcm:action", "add"
objxmlchild06.appendChild objxmlchild07

                Set objxmlchild08 = xmlDoc.createElement("Value")
                objxmlchild08.text = "1"
                objxmlchild07.appendChild objxmlchild08

                Set objxmlchild08 = xmlDoc.createElement("key")
                objxmlchild08.text = "/IMAGE/INDEX"
                objxmlchild07.appendChild objxmlchild08
            end if
         
            '=== installto
if installtotag01 = 1 then

Set objxmlchild06 = xmlDoc.createElement("InstallTo")
objxmlchild05.appendChild objxmlchild06

Set objxmlchild07 = xmlDoc.createElement("DiskID")
objxmlchild07.text = "0"
objxmlchild06.appendChild objxmlchild07

Set objxmlchild07 = xmlDoc.createElement("PartitionID")
objxmlchild07.text = "1"
objxmlchild06.appendChild objxmlchild07
end if

Set objxmlchild06 = xmlDoc.createElement("InstallToAvailablePartition")
objxmlchild06.text = "false"
objxmlchild05.appendChild objxmlchild06

Set objxmlchild06 = xmlDoc.createElement("WillShowUI")
objxmlchild06.text = "OnError"
objxmlchild05.appendChild objxmlchild06

Set objxmlchild04 = xmlDoc.createElement("UserData")
objxmlchild03.appendChild objxmlchild04

Set objxmlchild05 = xmlDoc.createElement("AcceptEula")
objxmlchild05.text = "true"
objxmlchild04.appendChild objxmlchild05

Set objxmlchild05 = xmlDoc.createElement("FullName")
objxmlchild05.text = fullname01
objxmlchild04.appendChild objxmlchild05

if len(Organization01) > 0 then
Set objxmlchild05 = xmlDoc.createElement("Organization")
objxmlchild05.text = organization01
objxmlchild04.appendChild objxmlchild05
          end if

Set objxmlchild05 = xmlDoc.createElement("ProductKey")
objxmlchild04.appendChild objxmlchild05

Set objxmlchild06 = xmlDoc.createElement("Key")
objxmlchild06.text = productkey01
objxmlchild05.appendChild objxmlchild06

Set objxmlchild04 = xmlDoc.createElement("EnableFirewall")
objxmlchild04.text = enablefirewall01
objxmlchild03.appendChild objxmlchild04

next

'=== Microsoft-Windows-LUA-Settings
for each arch01 in archs01

Set objxmlchild02 = xmlDoc.createElement("settings")
objxmlchild02.SetAttribute "pass", "offlineServicing"
objxmlchild01.appendChild objxmlchild02

Set objxmlchild03 = xmlDoc.createElement("component")
objxmlchild03.SetAttribute "name", "Microsoft-Windows-LUA-Settings"
objxmlchild03.SetAttribute "processorArchitecture", arch01
objxmlchild03.SetAttribute "publicKeyToken", "31bf3856ad364e35"
objxmlchild03.SetAttribute "language", "neutral"
objxmlchild03.SetAttribute "versionScope", "nonSxS"
objxmlchild03.SetAttribute "xmlns:wcm", "http://schemas.microsoft.com/WMIConfig/2002/State"
objxmlchild03.SetAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
objxmlchild02.appendChild objxmlchild03

Set objxmlchild04 = xmlDoc.createElement("EnableLUA")
objxmlchild04.text = "false"
objxmlchild03.appendChild objxmlchild04
next

'=== Microsoft-Windows-Security-SPP
for each arch01 in archs01

Set objxmlchild02 = xmlDoc.createElement("settings")
objxmlchild02.SetAttribute "pass", "generalize"
objxmlchild01.appendChild objxmlchild02

Set objxmlchild03 = xmlDoc.createElement("component")
objxmlchild03.SetAttribute "name", "Microsoft-Windows-Security-SPP"
objxmlchild03.SetAttribute "processorArchitecture", arch01
objxmlchild03.SetAttribute "publicKeyToken", "31bf3856ad364e35"
objxmlchild03.SetAttribute "language", "neutral"
objxmlchild03.SetAttribute "versionScope", "nonSxS"
objxmlchild03.SetAttribute "xmlns:wcm", "http://schemas.microsoft.com/WMIConfig/2002/State"
objxmlchild03.SetAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
objxmlchild02.appendChild objxmlchild03

Set objxmlchild04 = xmlDoc.createElement("SkipRearm")
objxmlchild04.text = "1"
objxmlchild03.appendChild objxmlchild04

next

    '=== Microsoft-Windows-International-Core
 
 
Set objxmlchild02 = xmlDoc.createElement("settings")
objxmlchild02.SetAttribute "pass", "specialize"
objxmlchild01.appendChild objxmlchild02

    for each arch01 in archs01
Set objxmlchild03 = xmlDoc.createElement("component")
objxmlchild03.SetAttribute "name", "Microsoft-Windows-International-Core"
objxmlchild03.SetAttribute "processorArchitecture", arch01
objxmlchild03.SetAttribute "publicKeyToken", "31bf3856ad364e35"
objxmlchild03.SetAttribute "language", "neutral"
objxmlchild03.SetAttribute "versionScope", "nonSxS"
objxmlchild03.SetAttribute "xmlns:wcm", "http://schemas.microsoft.com/WMIConfig/2002/State"
objxmlchild03.SetAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
objxmlchild02.appendChild objxmlchild03

'=== canada quebec setup language here
Set objxmlchild04 = xmlDoc.createElement("InputLocale")
objxmlchild04.text = InputLocale11
objxmlchild03.appendChild objxmlchild04

Set objxmlchild04 = xmlDoc.createElement("SystemLocale")
objxmlchild04.text = SystemLocale11
objxmlchild03.appendChild objxmlchild04
Set objxmlchild04 = xmlDoc.createElement("UILanguage")
objxmlchild04.text = UILanguage12
objxmlchild03.appendChild objxmlchild04
Set objxmlchild04 = xmlDoc.createElement("UILanguageFallback")
objxmlchild04.text = UILanguageFallback11
objxmlchild03.appendChild objxmlchild04
Set objxmlchild04 = xmlDoc.createElement("UserLocale")
objxmlchild04.text = UserLocale11
objxmlchild03.appendChild objxmlchild04

next

'=== Microsoft-Windows-Security-SPP-UX

      for each arch01 in archs01
   
Set objxmlchild03 = xmlDoc.createElement("component")
objxmlchild03.SetAttribute "name", "Microsoft-Windows-Security-SPP-UX"
objxmlchild03.SetAttribute "processorArchitecture", arch01
objxmlchild03.SetAttribute "publicKeyToken", "31bf3856ad364e35"
objxmlchild03.SetAttribute "language", "neutral"
objxmlchild03.SetAttribute "versionScope", "nonSxS"
objxmlchild03.SetAttribute "xmlns:wcm", "http://schemas.microsoft.com/WMIConfig/2002/State"
objxmlchild03.SetAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
objxmlchild02.appendChild objxmlchild03

Set objxmlchild04 = xmlDoc.createElement("SkipAutoActivation")
objxmlchild04.text = "true"
objxmlchild03.appendChild objxmlchild04
   
      next
   
      '=== Microsoft-Windows-SQMApi
   
      for each arch01 in archs01

Set objxmlchild03 = xmlDoc.createElement("component")
objxmlchild03.SetAttribute "name", "Microsoft-Windows-SQMApi"
objxmlchild03.SetAttribute "processorArchitecture", arch01
objxmlchild03.SetAttribute "publicKeyToken", "31bf3856ad364e35"
objxmlchild03.SetAttribute "language", "neutral"
objxmlchild03.SetAttribute "versionScope", "nonSxS"
objxmlchild03.SetAttribute "xmlns:wcm", "http://schemas.microsoft.com/WMIConfig/2002/State"
objxmlchild03.SetAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
objxmlchild02.appendChild objxmlchild03

Set objxmlchild04 = xmlDoc.createElement("CEIPEnabled")
objxmlchild04.text = "0"
objxmlchild03.appendChild objxmlchild04

      next

'=== Microsoft-Windows-Shell-Setup"

for each arch01 in archs01

Set objxmlchild03 = xmlDoc.createElement("component")
objxmlchild03.SetAttribute "name", "Microsoft-Windows-Shell-Setup"
objxmlchild03.SetAttribute "processorArchitecture", arch01
objxmlchild03.SetAttribute "publicKeyToken", "31bf3856ad364e35"
objxmlchild03.SetAttribute "language", "neutral"
objxmlchild03.SetAttribute "versionScope", "nonSxS"
objxmlchild03.SetAttribute "xmlns:wcm", "http://schemas.microsoft.com/WMIConfig/2002/State"
objxmlchild03.SetAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
objxmlchild02.appendChild objxmlchild03

if len(computername01)<>0 then
Set objxmlchild04 = xmlDoc.createElement("ComputerName")
objxmlchild04.text = computername01
objxmlchild03.appendChild objxmlchild04
        end if

Set objxmlchild04 = xmlDoc.createElement("ProductKey")
objxmlchild04.text = productkey01
objxmlchild03.appendChild objxmlchild04

      next

    '=== oobeSystem

Set objxmlchild02 = xmlDoc.createElement("settings")
objxmlchild02.SetAttribute "pass", "oobeSystem"
objxmlchild01.appendChild objxmlchild02

    for each arch01 in archs01
 
Set objxmlchild03 = xmlDoc.createElement("component")
objxmlchild03.SetAttribute "name", "Microsoft-Windows-Shell-Setup"
objxmlchild03.SetAttribute "processorArchitecture", arch01
objxmlchild03.SetAttribute "publicKeyToken", "31bf3856ad364e35"
objxmlchild03.SetAttribute "language", "neutral"
objxmlchild03.SetAttribute "versionScope", "nonSxS"
objxmlchild03.SetAttribute "xmlns:wcm", "http://schemas.microsoft.com/WMIConfig/2002/State"
objxmlchild03.SetAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
objxmlchild02.appendChild objxmlchild03

Set objxmlchild04 = xmlDoc.createElement("AutoLogon")
objxmlchild03.appendChild objxmlchild04

Set objxmlchild05 = xmlDoc.createElement("Password")
objxmlchild04.appendChild objxmlchild05

Set objxmlchild06 = xmlDoc.createElement("Value")
objxmlchild06.text = password01
objxmlchild05.appendChild objxmlchild06

Set objxmlchild06 = xmlDoc.createElement("PlainText")
objxmlchild06.text = "true"
objxmlchild05.appendChild objxmlchild06

Set objxmlchild05 = xmlDoc.createElement("Enabled")
objxmlchild05.text = "true"
objxmlchild04.appendChild objxmlchild05

Set objxmlchild05 = xmlDoc.createElement("Username")
objxmlchild05.text = username01
objxmlchild04.appendChild objxmlchild05

Set objxmlchild04 = xmlDoc.createElement("OOBE")
objxmlchild03.appendChild objxmlchild04

Set objxmlchild05 = xmlDoc.createElement("HideEULAPage")
objxmlchild05.text = "true"
objxmlchild04.appendChild objxmlchild05

Set objxmlchild05 = xmlDoc.createElement("HideOEMRegistrationScreen")
objxmlchild05.text = "true"
objxmlchild04.appendChild objxmlchild05

Set objxmlchild05 = xmlDoc.createElement("HideOnlineAccountScreens")
objxmlchild05.text = "true"
objxmlchild04.appendChild objxmlchild05

Set objxmlchild05 = xmlDoc.createElement("HideWirelessSetupInOOBE")
objxmlchild05.text = "true"
objxmlchild04.appendChild objxmlchild05

Set objxmlchild05 = xmlDoc.createElement("NetworkLocation")
objxmlchild05.text = NetworkLocation01
objxmlchild04.appendChild objxmlchild05

Set objxmlchild05 = xmlDoc.createElement("SkipUserOOBE")
objxmlchild05.text = "true"
objxmlchild04.appendChild objxmlchild05

Set objxmlchild05 = xmlDoc.createElement("SkipMachineOOBE")
objxmlchild05.text = "true"
objxmlchild04.appendChild objxmlchild05

Set objxmlchild05 = xmlDoc.createElement("ProtectYourPC")
objxmlchild05.text = ProtectYourPC01
objxmlchild04.appendChild objxmlchild05

Set objxmlchild04 = xmlDoc.createElement("UserAccounts")
objxmlchild03.appendChild objxmlchild04

Set objxmlchild05 = xmlDoc.createElement("LocalAccounts")
objxmlchild04.appendChild objxmlchild05

Set objxmlchild06 = xmlDoc.createElement("LocalAccount")
objxmlchild06.SetAttribute "wcm:action", "add"
objxmlchild05.appendChild objxmlchild06

Set objxmlchild07 = xmlDoc.createElement("Password")
objxmlchild07.text = password01
objxmlchild06.appendChild objxmlchild07

Set objxmlchild08 = xmlDoc.createElement("Value")
objxmlchild08.text = password01
objxmlchild07.appendChild objxmlchild08

Set objxmlchild08 = xmlDoc.createElement("PlainText")
objxmlchild08.text = "true"
objxmlchild07.appendChild objxmlchild08

Set objxmlchild07 = xmlDoc.createElement("Description")
objxmlchild07.text = description01
objxmlchild06.appendChild objxmlchild07

Set objxmlchild07 = xmlDoc.createElement("DisplayName")
objxmlchild07.text = displayname01
objxmlchild06.appendChild objxmlchild07

Set objxmlchild07 = xmlDoc.createElement("Group")
objxmlchild07.text = group01
objxmlchild06.appendChild objxmlchild07

Set objxmlchild07 = xmlDoc.createElement("Name")
objxmlchild07.text = name01
objxmlchild06.appendChild objxmlchild07

if len(RegisteredOrganization01)>0 then
Set objxmlchild04 = xmlDoc.createElement("RegisteredOrganization")
objxmlchild04.text = RegisteredOrganization01
objxmlchild03.appendChild objxmlchild04
        end if
     
        if len(RegistredOwner01)>0 then
Set objxmlchild04 = xmlDoc.createElement("RegisteredOwner")
objxmlchild04.text = RegistredOwner01
objxmlchild03.appendChild objxmlchild04
        end if
     
Set objxmlchild04 = xmlDoc.createElement("DisableAutoDaylightTimeSet")
objxmlchild04.text = "false"
objxmlchild03.appendChild objxmlchild04

Set objxmlchild04 = xmlDoc.createElement("FirstLogonCommands")
objxmlchild03.appendChild objxmlchild04

d = firstlogoncommands(objxmlchild04)

Set objxmlchild04 = xmlDoc.createElement("TimeZone")
objxmlchild04.text = timezone01
objxmlchild03.appendChild objxmlchild04
   
      next

'=== 64 bits

fil02.WriteLine date & " " & time & " Saving xml file: " & filenamefullxml02

xmlDoc.Save filenamefullxml02

fil02.WriteLine date & " " & time & " END"

fil02.close


'=======================================


function firstlogoncommands(objxmlchild04)

order01 = 0

filenamefull01 = basedir & "SynchronousCommand03_common.txt"
fil02.WriteLine date & " " & time & " common synchronous commands: " & filenamefull01
Set File01 = objFSo.OpenTextFile(filenamefull01, 1, true)

'=== read filed names (1st line)
  totline01 = 0
Do While file01.AtEndOfStream <> True
err01 = 0: err02 = "": on error resume next
line01 = file01.readline
line02 = file01.readline
line03 = file01.readline
err01 = err.number: err02 = err.message: on error goto 0

if err01 = 0 then
      err01 = 0: err02 = "": on error resume next
      line01 = line01 + 1 '=== check if it is a number
      err01 = err.number: err02 = err.message: on error goto 0
   
      if err01 = 0 then
        totline01 = totline01 + 3
        Set objxmlchild05 = xmlDoc.createElement("SynchronousCommand")
        objxmlchild05.SetAttribute "wcm:action", "add"
        objxmlchild04.appendChild objxmlchild05

          Set objxmlchild06 = xmlDoc.createElement("Description")
          objxmlchild06.text = line02
          objxmlchild05.appendChild objxmlchild06

          Set objxmlchild06 = xmlDoc.createElement("Order")
          order01 = order01 + 1
          objxmlchild06.text = order01
          objxmlchild05.appendChild objxmlchild06

          Set objxmlchild06 = xmlDoc.createElement("CommandLine")
          objxmlchild06.text = line03
          objxmlchild05.appendChild objxmlchild06

          Set objxmlchild06 = xmlDoc.createElement("RequiresUserInput")
          objxmlchild06.text = "false"
          objxmlchild05.appendChild objxmlchild06
      else
        fil02.WriteLine date & " " & time & " ERROR data integrity, need 1 number, description, command: " & totline01
      end if
    else
      fil02.WriteLine date & " " & time & " ERROR reading line at: " & totline01
    end if
loop
file01.close

if config01 = 1 then
filenamefull02 = basedir & "SynchronousCommand01_maison.txt"
elseif config01 = 2 then
filenamefull02 = basedir & "SynchronousCommand02_job.txt"
end if

fil02.WriteLine date & " " & time & " maison or job synchronous commands: " & filenamefull02
Set File02 = objFSo.OpenTextFile(filenamefull02, 1, true)

'=== read filed names (1st line)
  totline01 = 0
Do While file02.AtEndOfStream <> True

err01 = 0: err02 = "": on error resume next
line01 = file02.readline
line02 = file02.readline
line03 = file02.readline
err01 = err.number: err02 = err.message: on error goto 0
   
    if err01 = 0 then
      err01 = 0: err02 = "": on error resume next
      line01 = line01 + 1 '=== check if it is a number
      err01 = err.number: err02 = err.message: on error goto 0
   
      if err01 = 0 then  
        totline01 = totline01 + 3
        Set objxmlchild05 = xmlDoc.createElement("SynchronousCommand")
        objxmlchild05.SetAttribute "wcm:action", "add"
        objxmlchild04.appendChild objxmlchild05
       
          Set objxmlchild06 = xmlDoc.createElement("Description")
          objxmlchild06.text = line02
          objxmlchild05.appendChild objxmlchild06
   
          Set objxmlchild06 = xmlDoc.createElement("Order")
          order01 = order01 + 1
          objxmlchild06.text = order01
          objxmlchild05.appendChild objxmlchild06
   
          Set objxmlchild06 = xmlDoc.createElement("CommandLine")
          objxmlchild06.text = line03
          objxmlchild05.appendChild objxmlchild06
   
          Set objxmlchild06 = xmlDoc.createElement("RequiresUserInput")
          objxmlchild06.text = "false"
          objxmlchild05.appendChild objxmlchild06
      else
        fil02.WriteLine date & " " & time & " ERROR data integrity, need 1 number, description, command: " & totline01
      end if        
    else
      fil02.WriteLine date & " " & time & " ERROR reading line at: " & totline01
    end if
  loop
file02.close

end function

convert csv to xml

Hello,

Since i have nothing to do in my free time, i answered a post in expert exchange to convert a CSV to XML

Here is my code, it's a VBS script

It does not support everything the CSV can contain

The input CSV was sometimes with double quotes, sometimes not
Sometimes there was carriage return in a field, sometimes 2

So i support: double quotes in CSV
and up to two carriage return in a field
You can change it easily to support more carriage returns in a field

The files must all be in same folder

The log (file starting with ZZZ in same folder) will tell you if something went wrong


'=== CSV to xml
'=== by sergefournier@hotmail.com 2017-06-20

'=== save thsi script as: csv2xml.VBS
'=== input file must be sample1.csv in the same directory as the script (same folder)
'=== outputfile will be sampleout1.xml
'=== zzz_troubleshooting.txt will tell you what was not processed (lines)

'=== support 2 carriage return in a field, but not 3 :P

Set objFSO    = CreateObject("Scripting.FileSystemObject")

'=== actual drive, actual directory, and "\"
thepath=WScript.ScriptFullName
p = instrRev(thepath,"\")
basedir  = left(thepath,p)
filnam = right(thepath,len(thepath)-p)

logall = 1

if logall=1 then
   '=== debug log
   file02 = basedir & "zzz_troubleshooting.txt"
   on error resume next
   Set Fil02 = objFSo.OpenTextFile(file02, 2, true)
   on error goto 0
end if

if logall=1 then
   fil02.WriteLine date & " " & time & " START"
end if


'=== input (txt file, not using ODBC txt driver)
filename01 = basedir & "sample1.csv"
Set File01 = objFSo.OpenTextFile(filename01, 1, true)


'=== read filed names (1st line)


if file01.AtEndOfStream <> true then
line01 = file01.readline

'=== array with all field names
arr01 = split(line01,",")
for i = 0 to ubound(arr01)
arr01(i) = trim(arr01(i)) '=== remove spaces
arr01(i) = replace(arr01(i), " ", "")
arr01(i) = replace(arr01(i), "/", "")
fil02.WriteLine date & " " & time & " fieldname: " & arr01(i)
next

'=== spaces in xml name are not good


'=== output xml
'=== create xml
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set objRoot = xmlDoc.createElement("data")
xmlDoc.appendChild objRoot

Set objIntro = xmlDoc.createProcessingInstruction("xml","version='1.0'")
xmlDoc.insertBefore objIntro,xmlDoc.childNodes(0)

xmlDoc.Save basedir & "sampleout1.xml"


'=== add a record
Set xmlDoc = CreateObject("Microsoft.XMLDOM")

xmlDoc.Async = "False"
xmlDoc.Load(basedir & "sampleout1.xml")

Set objRoot = xmlDoc.documentElement
linecount01 = 0

Do While file01.AtEndOfStream <> True
Set objRecord = xmlDoc.createElement("client")
objRoot.appendChild objRecord

line01 = file01.readline
'=== split value in CSV
arr02 = split(line01,",")

x = 0 '=== number of elements in new array to merge elements with double quotes
redim arr03(x)

'2017-06-20 21:43:50 DATA before: 10400,Pep,Pepmiller,Pep.Pepmiller@RalphLauren.com,"2800 Routh Street, Suite 260",Dallas,TX,75201
'2017-06-20 21:43:50 DATA after : ,10400,Pep,Pepmiller,Pep.Pepmiller@RalphLauren.com,2800 Routh Street"2800 Routh Street Suite 260,TX,75201
if ubound(arr02) <> 0 then
if ubound(arr01) <> ubound(arr02) then

'=== do we have a double quote and a carriage return before we meet the closing double quote
doublequoteanomaly01 = 1
for i = 0 to ubound(arr02)
'=== search for a closing double quote, in case a carriage return separate the line
if right(arr02(i),1) = """" then
'=== found a closing double quote, no anomaly
doublequoteanomaly01 = 0
end if
next

if doublequoteanomaly01 = 1 then
fil02.WriteLine date & " " & time & " --- found double quote alone, will add next line: " & linecount01
'=== we have only one double quote in the line, wich mean there is a carriage return after the double quote
'=== we have to read the next line and merge both lines
if file01.AtEndOfStream <> true then
line03 = file01.readline
linecount01 = linecount01 + 1
'=== data was on two line, we add a space instead of a carriage return
'=== xml will support a carriage return special code
line01 = line01 & " " & line03

if instr(line03, """") = 0 then
fil02.WriteLine date & " " & time & " --- final double quote not in line, reading another line: " & linecount01
if file01.AtEndOfStream <> true then
line03 = file01.readline
linecount01 = linecount01 + 1
line01 = line01 & " " & line03
end if
end if

arr02 = split(line01,",")
end if
end if



if ubound(arr01) <> ubound(arr02) then
'=== a data might have quote to support a comma inside of it
'fil02.WriteLine date & " " & time & " DATA before: " & line01

line02 = ""
for i=0 to ubound(arr02)
if i < ubound(arr02) then
line02 = line02 & arr02(i) & ","
else
line02 = line02 & arr02(i)
end if
next

'fil02.WriteLine date & " " & time & " DATA befor2: " & line02

skip01 = 0
for i = 0 to ubound(arr02)

newdata01 = arr02(i)


if left(arr02(i),1) = """" then
'=== double quote found
newdata01 = right(newdata01,len(Arr02(i))-1) & ","
i3 = i + 1
for i2 = i3 to ubound(arr02)
if right(arr02(i2),1) = """" then
newdata01 = newdata01 & left(arr02(i2),len(arr02(i2))-1)
i = i + 1
'=== end double quote found, we exit the for i2
exit for
else
newdata01 = newdata01 & arr02(i2)
i = i + 1
end if
next
end if


redim preserve arr03(x)
arr03(x) = newdata01
x = x + 1

next
arr02 = arr03

line02 = ""
for i=0 to ubound(arr03)
if i < ubound(arr03) then
line02 = line02 & arr03(i) & ","
else
line02 = line02 & arr03(i)
end if
next
'fil02.WriteLine date & " " & time & " DATA after : " & line02
else
'=== reading second line was enough for element to fit in numbers (data number = fields numbers)
'=== there was no comma, justye a carriage return
'=== just remove double quotes in the splitted elements
for i=0 to ubound(arr02)
arr02(i) = replace(arr02(i),"""","")
next

end if

end if

if ubound(arr01) = ubound(arr02) then

for i = 0 to ubound(arr01)

Set objFieldValue = xmlDoc.createElement(arr01(i))
'objfieldvalue.SetAttribute "displaynamefra", "Numéro"
objFieldValue.Text = arr02(i)
objRecord.appendChild objFieldValue
next
else
fil02.WriteLine date & " " & time & " ERROR line: " & linecount01
fil02.WriteLine date & " " & time & " the number of columns (fields) does not correspond to the number of data"
fil02.WriteLine date & " " & time & " ubound arr01: " & ubound(arr01)
fil02.WriteLine date & " " & time & " ubound arr02: " & ubound(arr02)
fil02.WriteLine date & " " & time & " data: " & line01
end if
else
fil02.WriteLine date & " " & time & " ERROR line empty: " & line02
end if
linecount01 = linecount01 + 1

loop

xmlDoc.Save basedir & "sampleout1.xml"
else
msg01 = "ERROR input file is empty"
msgbox(msg01)
end if


file01.close

Virtualbox change UUID (GUID)

Hello,

I am lazy
So when i read that to change a virtualbox UUID (GUID) you had to:
1. run a command in virtualbox folder to change VDI file's UUID
2. change the machine UUID in the .VBOX file
3. change the HardDisk UUID to reflect the VDI UUID
4. change the Image UUID to reflect the VDI UUID

I had to do something automating this process

This small script, will:
find location of virtualbox folder (5.x)
Run VBoxManage.exe to change VDI file UUID (guid)
EDIT .VBOX (that is a XML file) and change the 3 id: machine, harddisk (same as VDI) and image (same as VDI)

Put the script in the same folder as the VBOX and VDI file
(it will browse the folder to find a .VDI file and a .VBOX file, ONLY one of each)

here it is:

------------------------ vbox_set_new_id.vbs -----------------------

'=== using vboxmanage, this script will assign a new UID to a virtualbox machine, hard disk and image

Set objshe = WScript.CreateObject("WScript.Shell")
Set objFSO = wscript.CreateObject("Scripting.FileSystemObject")
Set objNet    = CreateObject("WScript.Network")

Const hkcr = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const hklm = &H80000002 'HKEY_LOCAL_MACHINE
Const hku  = &H80000003 'HKEY_USERS
Const hkcc = &H80000005 'HKEY_CURRENT_CONFIG

'=== actual drive, actual directory, and "\"
thepath=WScript.ScriptFullName
p = instrRev(thepath,"\")
basedir  = left(thepath,p)
filnam = right(thepath,len(thepath)-p)

'=== restart the script in 32 bits if we are on a 64 bits system (if wa want that architecture)
'=== (most of the time, ODBC is available only in 32 bits)
architecturewanted01 = 64

if architecturewanted01 = 32 then
a64 = windir & "\syswow64\wscript.exe"

if objFSO.fileEXISTS(a64) and instr(lcase(wscript.fullname),"syswow64")=0 then
  '=== 64 bits system detected, restart in 32 bits
  a = """" & a64 & """ """ & basedir & filnam & """"
  objshe.Run a,0, false
  wscript.quit
end if
end if

logall = 1

if logall=1 then
   '=== debug log
   file02 = basedir & "zzz_troubleshooting.txt"
   on error resume next
   Set Fil02 = objFSo.OpenTextFile(file02, 2, true)
   on error goto 0
end if

'=== virtualbox assign new UID to a VM to be able to copy it
'=== value
'=== chek if the file already exist
Set objFol01=objFSO.GetFolder(basedir)'=== dir
Set objfol02=objFol01.files '=== files


regpath01 = "SOFTWARE\Oracle\VirtualBox"
virtualboxpath01 = regrea(0, hklm, regpath01, "installdir")
'pathcom01 = "C:\Program Files\Oracle\VirtualBox" '=== manual path for virtualbox commandline

if not isnull(useoff) then
'=== get all filename in this folder, put them in array
x=0
redim ara01(0)
dimnum=1
For Each objFil in objFol02
filnam=objfil.name
filnam=lcase(filnam)
if right(filnam,4)=".vdi" then
redim preserve ara01(x)
ara01(x)=filnam
x=x+1
end if
next
if x = 1 then
'=== found 1 .VDI file
'com01 = virtualboxpath01 & "VBoxManage.exe internalcommands sethduuid ""/home/user/VirtualBox VMs/drupal/drupal.vhd"""

''''''''''''''''''''''''''''''
' VDI guid (diskfile)
''''''''''''''''''''''''''''''
Set TypeLib = CreateObject("Scriptlet.TypeLib")
vdiguid01 = TypeLib.Guid
vdiguid01 = left(vdiguid01, len(vdiguid01)-2) '=== remove two NULL at end
fil02.writeline "vbox machine future vdiguid01: " & vboxguid01

com01 = """" & virtualboxpath01 & "VBoxManage.exe"" internalcommands sethduuid """ & basedir & ara01(0) & """ " & vdiguid01
fil02.writeline com01
'msgbox(com01)
'=== set new GUID for the VDI (disk)
objshe.Run com01, 0, false

x=0
redim ara01(0)
dimnum=1
For Each objFil in objFol02
filnam=objfil.name
filnam=lcase(filnam)
if right(filnam,5)=".vbox" then
redim preserve ara01(x)
ara01(x)=filnam
x=x+1
end if
next

if x = 1 then
'=== xml filename for .VBOX file
filename01 = ara01(0)

'''''''''''''''''''''''''''''''''''''''''''''''''
' machine GUID
'''''''''''''''''''''''''''''''''''''''''''''''''
Set TypeLib = CreateObject("Scriptlet.TypeLib")
vboxguid01 = TypeLib.Guid
vboxguid01 = left(vboxguid01, len(vboxguid01)-2) '=== remove two NULL at end
fil02.writeline "vbox machine future vboxguid01: " & vboxguid01
fil02.writeline "vbox xml filename: " & filename01
'=== change VBOX xml file

Set xmlDoc = CreateObject("Microsoft.XMLDOM")

xmlDoc.Async = "False"
xmlDoc.Load(filename01)
'Set objRoot = xmlDoc.documentElement

'=== root node level 0
'Set Node00 = objroot.SelectSingleNode("/*")

'=== references
'https://msdn.microsoft.com/en-us/library/system.xml.xmlelement(v=vs.100).aspx

'Set colNodes01 = xmlDoc.selectNodes("/*")
'<VirtualBox xmlns="http://www.virtualbox.org/" version="1.15-windows">
'  <Machine uuid="{bee53fbc-651d-4ddb-9e48-10923f5a8f6e}" name="win7sp1" OSType="Windows7_64" snapshotFolder="Snapshots" lastStateChange="2017-06-04T00:22:09Z">
'    <MediaRegistry>
'      <HardDisks>
'        <HardDisk uuid="{76394b53-4740-4ba0-a422-017eaaaaa020}"
'    <StorageControllers>
'      <StorageController name="SATA" type="AHCI" PortCount="3" useHostIOCache="false" Bootable="true" IDE0MasterEmulationPort="0" IDE0SlaveEmulationPort="1" 'IDE1MasterEmulationPort="2" IDE1SlaveEmulationPort="3">
'        <AttachedDevice type="HardDisk" hotpluggable="false" port="0" device="0">
'          <Image uuid="{76394b53-4740-4ba0-a422-017eaaaaa020}"/>

'open the .vbox file in a text editor
'replace the UUID found in Machine uuid="{...}" with the UUID you got when you ran sethduuid the first time
'replace the UUID found in HardDisk uuid="{...}" and in Image uuid="{}" (towards the end) with the UUID you got when you ran sethduuid the second time
'=== machine GUID or UUID replacement
xmlpath01 = "/VirtualBox/Machine"
Set colNodes01 = xmlDoc.selectNodes(xmlpath01)
node = 1
For Each objNode in colNodes01
fil02.writeline "vbox machine guid nodes browsing..."
'=== get machine GUID (or UUID)
value01 = objNode.getattribute("uuid")
fil02.writeline xmlpath01 & ": (before) " & value01
objNode.SetAttribute "uuid", vboxguid01
value01 = objNode.getattribute("uuid")
fil02.writeline xmlpath01 & ": (after ) " & value01
next
Set colNodes01 = nothing
'''''''''''''''''''''''''''''''''
' hd and image GUID
'''''''''''''''''''''''''''''''''
'Set TypeLib = CreateObject("Scriptlet.TypeLib")
'hdimageguid01 = TypeLib.Guid
'hdimageguid01 = left(hdimageguid01, len(hdimageguid01)-2) '=== remove two NULL at end
hdimageguid01 = vdiguid01
fil02.writeline "vbox machine future hdimageguid01: " & hdimageguid01

'=== harddisk GUID
xmlpath01 = "/VirtualBox/Machine/MediaRegistry/HardDisks/HardDisk"
Set colNodes01 = xmlDoc.selectNodes(xmlpath01)
node = 1
For Each objNode in colNodes01
fil02.writeline "vbox harddisk guid nodes browsing..."
'=== get harddisk GUID (or UUID)
value01 = objNode.getattribute("uuid")
fil02.writeline xmlpath01 & ": (before) " & value01
objNode.SetAttribute "uuid", hdimageguid01
value01 = objNode.getattribute("uuid")
fil02.writeline xmlpath01 & ": (after ) " & value01
next
Set colNodes01 = nothing

'=== image GUID
xmlpath01 = "/VirtualBox/Machine/StorageControllers/StorageController/AttachedDevice/Image"
Set colNodes01 = xmlDoc.selectNodes(xmlpath01)
node = 1
For Each objNode in colNodes01
fil02.writeline "vbox harddisk guid nodes browsing..."
'=== get Image GUID (or UUID)
value01 = objNode.getattribute("uuid")
fil02.writeline xmlpath01 & ": (before) " & value01
objNode.SetAttribute "uuid", hdimageguid01
value01 = objNode.getattribute("uuid")
fil02.writeline xmlpath01 & ": (after ) " & value01
next
Set colNodes01 = nothing

xmlDoc.Save basedir & filename01

else
msg01 = "ERROR found too many or too few VBOX files"
msg01 = msg01 & "Number of vm files found: " & x
msgbox(msg01)
end if
ELSE
msg01 = "ERROR found too many or too few VDI files"
msg01 = msg01 & "Number of vm files found: " & x
msgbox(msg01)
END IF
else
'=== virtualbox not found
msg01 = "ERROR virtualbox register key installdir not found"
msg01 = msg01 & "reg key wanted: HKEY_LOCAL_MACHINE\" & regpath01
msgbox(msg01)
end if

if logall=1 then
   fil02.WriteLine date & " " & time & " END"
end if
if logall = 1 then
   fil02.close
end if

'============================================================================

'=== lis le registre en mode 32 bits, si rien, lis en 64 bits
function regrea(r2egrea_mode, r2egrea_clef01, r2egrea_clef02, r2egrea_clef03)
   'Inparams.Hdefkey = regrea_clef01
   'Inparams.Ssubkeyname = regrea_clef02
   'Inparams.Svaluename = regrea_clef03

if regrea_mode=0 then
r2egrea_mode=64
end if
regrea = regrea2(r2egrea_mode, r2egrea_clef01, r2egrea_clef02, r2egrea_clef03)

IF ISNULL(regrea) THEN
r2egrea_mode=32
regrea = regrea2(r2egrea_mode, r2egrea_clef01, r2egrea_clef02, r2egrea_clef03)
else
if len(regrea) = 0 then
 r2egrea_mode=32
 regrea = regrea2(r2egrea_mode, r2egrea_clef01, r2egrea_clef02, r2egrea_clef03)
end if
end if
end function

'=== lis le registre en mode regrea_mode
function regrea2(regrea_mode, regrea_clef01, regrea_clef02, regrea_clef03)

   Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
   on error resume next
   objCtx.Add "__ProviderArchitecture", regrea_mode
 
   if err.number<>0 then
      toterrcop = toterrcop +1
      msgfin03 = msgfin03 & vbcrlf & "error - __ProviderArchitecture: " & vbcrlf
      if usenam=debugname then
                              msgbox("erreur __ProviderArchitecture" & vbcrlf & err.description & vbcrlf & path01 & vbcrlf & key)
      end if
   end if
   Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
   Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx)
   Set objStdRegProv = objServices.Get("StdRegProv")

   Set Inparams = objStdRegProv.Methods_("GetStringValue").Inparameters
   Inparams.Hdefkey = regrea_clef01
   Inparams.Ssubkeyname = regrea_clef02
   Inparams.Svaluename = regrea_clef03
   set Outparams = objStdRegProv.ExecMethod_("GetStringValue", Inparams,,objCtx)

   '=== show output parameters object and the registry value HKLM\SOFTWARE\
   'WScript.Echo Outparams.GetObjectText_
   'WScript.Echo "WMI Logging is set to  " & Outparams.SValue
   regrea2 = Outparams.SValue

end function

outlook addin to copy hyperlink in clipboard

Hello,

2017-02-05 21:41
Changed global variable definition for event bug

2017-02-05 20:00
Changed the way to create outlook bar and buttons to be more dynamic (array of bars, array of buttons in bar)



This outlook addin was compiled as "outlook addin" in visual studio 2013
It is signed, but you can change the certificate before recompiling

Tested on outlook 2013

This will add a toolbar with "classer et faire lien" (wich is not what it is doing, it only does the link)

When you press the button in complements,  it will generate a hyperlink to the message(s) selected or to the message actually open at the moment.

then you can paste the link in any other application as it will be an html outlook link.



------------------- vb.net visual studio 2013 -----------------------------

Imports System.Object
Imports System.IO
Imports System.Windows.Forms

Public Class ThisAddIn

    Const RegHtml As String = "HTML Format"

    Public WithEvents inspectors01 As Outlook.Inspectors

    Public Class glovar
        '=== this class have variables global to all the other classes
        Public Shared button00 As Office.CommandBarButton '=== in explorer, aka main windows
        Public Shared button01 As Office.CommandBarButton '=== in explorer, aka main windows
        Public Shared button02 As Office.CommandBarButton '=== in explorer, aka main windows

    End Class

'=== structure to pass to a function to create a toolbar in outlook

    Public Structure bar_param
        Dim bar_Exist01 As Integer   '=== if bar exist we do not recreate
        Dim bar_Caption01 As String   '=== name of bar
        Dim bar_inexplorer01 As Integer '=== create in main outlook window
        Dim bar_ininspector01 As Integer '=== create in message window
        Dim explorerorinspector01 As Object
        Dim buttons01 As but_param()

    End Structure

'=== strucutre to pass to a function to create a button in the bar we created just before

    Public Structure but_param
        Dim bar_obj As Object
        Dim but_exist01 As Integer
        Dim but_Caption01 As String
        Dim but_tooltip01 As String
        Dim but_onaction01 As String
        Dim but_face01 As Integer           '=== icon
        Dim but_inexplorer01 As Integer     '=== in main outlook window
        Dim but_ininspector01 As Integer    '=== in message window
        Dim but_bar01 As Object             '=== bar to add button to

    End Structure

    Private Sub ThisAddIn_Startup() Handles Me.Startup
        Dim inspector01 As Microsoft.Office.Interop.Outlook.Inspector
        inspectors01 = Me.Application.Inspectors

        Dim dummy As Integer

        dummy = add_bar_and_buttons(Globals.ThisAddIn.Application.ActiveExplorer)

        Dim objNet = CreateObject("WScript.Network")
        '=== get username logon from local machine
        Dim usenam As String = LCase(objNet.UserName)

    End Sub

    Private Sub ThisAddIn_Shutdown() Handles Me.Shutdown
        'outlookaddin1 = Nothing
    End Sub

    'Dim bar01 As Office.CommandBar '=== in explorer
    'Dim bar03 As Office.CommandBar '=== in inspector

    Public Sub inspectors01_NewInspector(ByVal Inspector As Microsoft.Office.Interop.Outlook.Inspector) Handles inspectors01.NewInspector

        '=== a new inspector just openned (a new mail maybe?)
        Dim dummy As Integer
        'MsgBox("new inspector")
        dummy = add_bar_and_buttons(Inspector)

        'If logall = 1 Then file02.writeline(Now & " adding bar in inspector")

    End Sub


    Private Sub copierhyperlien01(ByVal ctrl As Office.CommandBarButton, ByRef Cancel As Boolean)

        '''''''''''''''''''''''''''''''''
        ' the mail is open in inspector
        '''''''''''''''''''''''''''''''''
        Dim inspector01 As Microsoft.Office.Interop.Outlook.Inspector
        inspector01 = Globals.ThisAddIn.Application.ActiveInspector

        Dim item01(0) As Object
        Dim item01ismailininspector = 0

        If Not inspector01 Is Nothing Then
            Try
                '=== check the actual openned item, if it does not exist, then there is no mail open at the moment
                item01(0) = inspector01.CurrentItem
                item01ismailininspector = 1
            Catch ex As Exception
                '=== no item is openned, we create one later
                item01(0) = Nothing
            End Try
        Else
            '=== no inspector, that mean there is no item opened
        End If

        Dim itemcnt = 0

        If item01ismailininspector = 0 Then
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' get all selected items in explorer (not inspector, wich would be an open item)
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            '=== selected items in explorer window
            Dim explorer01 = Globals.ThisAddIn.Application.ActiveExplorer
            Dim selection01 = explorer01.Selection

            For Each item02 In selection01
                ReDim Preserve item01(itemcnt)
                item01(itemcnt) = item02
                itemcnt = itemcnt + 1
            Next
            itemcnt = itemcnt - 1
            'MsgBox(selection01.Count)

        Else
            '=== the email is open right now in inspector
            '=== we have only one email to process
        End If

        Dim link01 As String = ""

        For i = 0 To itemcnt

            If TypeOf item01(i) Is Outlook.MailItem Then
                link01 = link01 & "<a href=""outlook:" & item01(i).EntryID & """>" & _
                "LIEN OUTLOOK From: " & item01(i).SenderName & _
                " Sujet: " & item01(i).Subject & _
                " Date: " & item01(i).ReceivedTime & _
                " Categorie: " & item01(i).categories & _
                "</a><br>"
            ElseIf TypeOf item01(i) Is Outlook.TaskItem Then
                link01 = link01 & "<a href=""outlook:" & item01(i).EntryID & """>" & _
                "LIEN OUTLOOK From: " & item01(i).Owner & _
                " Sujet: " & item01(i).Subject & _
                " Date due: " & item01(i).DueDate & _
                " Categorie: " & item01(i).categories & _
                "</a><br>"
            ElseIf TypeOf item01(i) Is Outlook.ReportItem Then
                link01 = link01 & "<a href=""outlook:" & item01(i).EntryID & """>" & _
                "LIEN OUTLOOK From: OUTLOOK" & _
                " Sujet: " & item01(i).Subject & _
                " Date: " & item01(i).CreationTime & _
                " Categorie: " & item01(i).categories & _
                "</a><br>"
            ElseIf TypeOf item01(i) Is Outlook.ContactItem Then
                link01 = link01 & "<a href=""outlook:" & item01(i).EntryID & """>" & _
                "LIEN OUTLOOK From: " & item01(i).FullNameAndCompany & _
                " Categorie: " & item01(i).categories & _
                "</a><br>"
                '" Date: " & message.CreationTime & _
                '" Sujet: " & message.Subject & _
            Else
                link01 = link01 & "ERREUR - Un item dans votre sélection est... étrange - pas de lien dans le presse-papier<br>"
            End If

        Next

        '=== convert link to html ready to be put in clipboard
        Dim dummy = SetHtml_put_in_clipboard(link01)

        'MsgBox("You clicked: " + ctrl.Caption + vbCrLf + "link01: " + link01)
        '=== put link01 in clipboard



        '=== futur search for client contract number to move the mail to a client contract folder

        'Dim txt02 = mail01(itemcnt).HTMLBody

        '=== warning if a whole groupe was selected (selection of a whole day by accident)

        '=== get subject and search 999000 (id)

        '=== if no id found, ask for an id to be able to move the email in a folder

        '=== get email content and search for 999000 (999 = client, 000 = project)

        '=== search public folder for this id number (999000) 999 = client 000 = project

        '=== if no public folder, search in inbox folder

        '=== if noinbox folder, create one

        '=== move a copy of the email in deleted items

        '=== move the email in public folder or inbox folder



    End Sub

    Function SetHtml_put_in_clipboard(ByVal NewVal As String) As Boolean

        '=== source: html string
        '=== destination: html data block for clipboard

        Dim n As String
        Dim o As Object
        Dim p As Object
        Dim q As Object
        Dim r As String
        Dim i As Integer
        Dim s As String

        '=== replace all special caracters 128+ ascii with a code for html code
        i = 1
        While i < Len(NewVal)
            s = Mid(NewVal, i, 1)
            r = Asc(s)
            If r > 128 Then
                NewVal = Replace(NewVal, s, "&#" & Trim(CStr(r)) & ";")
                i = i + 3 + Len(Trim(CStr(r)))
            Else
                i = i + 1
            End If
        End While

        '=== build html structure for clipboard
        n = "Version:0.9" & vbCrLf
        n = n & "StartHTML:00000000" & vbCrLf
        n = n & "EndHTML:00000000" & vbCrLf
        n = n & "StartFragment:00000000" & vbCrLf
        n = n & "EndFragment:00000000" & vbCrLf
        n = n & "StartSelection:00000000" & vbCrLf
        n = n & "EndSelection:00000000" & vbCrLf
        n = n & "<html><body>" & vbCrLf
        n = n & "<!--StartFragment-->" & vbCrLf
        n = n & NewVal & vbCrLf
        n = n & "<!--EndFragment-->" & vbCrLf
        n = n & "</BODY></HTML>" & vbCrLf

        'Version: vv version number of the clipboard. Starting version is 0.9.
        'StartHTML: bytecount from the beginning of the clipboard to the start of the context, or -1 if no context.
        'EndHTML: bytecount from the beginning of the clipboard to the end of the context, or -1 if no context.
        'StartFragment: bytecount from the beginning of the clipboard to the start of the fragment.
        'EndFragment: bytecount from the beginning of the clipboard to the end of the fragment.
        'StartSelection: bytecount from the beginning of the clipboard to the start of the selection.
        'EndSelection: bytecount from the beginning of the clipboard to the end of the selection.

        '=== once the string is done, we can chek where are the chekpoints
        '=== then write it in the string itself, padding with "0"
        q = "<html>"
        p = Trim(CStr(InStr(LCase(n), q) - 1))
        o = StrDup(8 - Len(p), "0") & p
        n = Replace(n, "StartHTML:00000000", "StartHTML:" & o, 1, 1)

        q = ""
        p = Trim(CStr(Len(n)))
        o = StrDup(8 - Len(p), "0") & p
        n = Replace(n, "EndHTML:00000000", "EndHTML:" & o, 1, 1)

        q = "<!--startfragment-->"
        p = Trim(CStr(InStr(LCase(n), q) + Len(q) - 1))
        o = StrDup(8 - Len(p), "0") & p
        n = Replace(n, "StartFragment:00000000", "StartFragment:" & o, 1, 1)

        q = "<!--endfragment-->"
        p = Trim(CStr(InStr(LCase(n), q) - 1))
        o = StrDup(8 - Len(p), "0") & p
        n = Replace(n, "EndFragment:00000000", "EndFragment:" & o, 1, 1)

        Dim dataObject = New DataObject()

        dataObject.SetData(DataFormats.Html, n)
        'dataObject.SetData(DataFormats.Text, NewVal)
        'dataObject.SetData(DataFormats.UnicodeText, NewVal)

        Clipboard.SetDataObject(dataObject, 1)

        Return 0

    End Function
    Function add_bar_and_buttons(inspectororexplorer01 As Object)

        Dim buttoncnt = 0
        Dim but_param01() As but_param

        buttoncnt = 0

        ReDim Preserve but_param01(buttoncnt)
        but_param01(buttoncnt).but_exist01 = 0
        but_param01(buttoncnt).but_Caption01 = "Aide Help"
        but_param01(buttoncnt).but_tooltip01 = "Aide sur ce addin"
        but_param01(buttoncnt).but_onaction01 = "aide01"
        but_param01(buttoncnt).but_face01 = 5432
        but_param01(buttoncnt).but_inexplorer01 = 1
        but_param01(buttoncnt).but_ininspector01 = 1

        buttoncnt = buttoncnt + 1
        ReDim Preserve but_param01(buttoncnt)
        but_param01(buttoncnt).but_exist01 = 0
        but_param01(buttoncnt).but_Caption01 = "Classer Item"
        but_param01(buttoncnt).but_tooltip01 = "Classer cet(ces) item dans un dossier de projet 999000"
        but_param01(buttoncnt).but_onaction01 = "classeritem01"
        but_param01(buttoncnt).but_face01 = 5432
        but_param01(buttoncnt).but_inexplorer01 = 1
        but_param01(buttoncnt).but_ininspector01 = 1

        buttoncnt = buttoncnt + 1
        ReDim Preserve but_param01(buttoncnt)
        but_param01(buttoncnt).but_exist01 = 0
        but_param01(buttoncnt).but_Caption01 = "Copier Hyperlien"
        but_param01(buttoncnt).but_tooltip01 = "Copier un lien vers cet item dans le presse papier"
        but_param01(buttoncnt).but_onaction01 = "copierhyperlien01"
        but_param01(buttoncnt).but_face01 = 5432
        but_param01(buttoncnt).but_inexplorer01 = 1
        but_param01(buttoncnt).but_ininspector01 = 1

        '=== toolbar
        Dim toolbarcnt = 0
        Dim bar_param01(toolbarcnt) As bar_param

        bar_param01(toolbarcnt).bar_Exist01 = 0
        bar_param01(toolbarcnt).bar_Caption01 = "Courriel01"
        bar_param01(toolbarcnt).bar_inexplorer01 = 1
        bar_param01(toolbarcnt).bar_ininspector01 = 1
        bar_param01(toolbarcnt).explorerorinspector01 = inspectororexplorer01
        bar_param01(toolbarcnt).buttons01 = but_param01

        '=== add a toolbar object in outlook explorer (main window) or inspector (message)
        '=== with a structure as parameter, we can add as many arguments we want before calling this function without modifying all the line that use it

        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' toolbar(s)
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim toolbar_Add As Office.CommandBar
        'Dim toolbar_Add As Microsoft.Office.Core.CommandBar
        'MsgBox("add bar and buttons called")
        For bartot01 = 0 To toolbarcnt

            Dim bars01 As Object

            Try
                bars01 = inspectororexplorer01.CommandBars
            Catch ex As Exception
                '=== no bars at all in customs bars in outlook
                'MsgBox("failed to get explorer bars or inspector bars")
            End Try

            If Not bars01 Is Nothing Then

                '=== check if in all bars in a bar with same name exist
                For Each bar01 In bars01
                    If Trim(LCase(bar01.Name)) = Trim(LCase(bar_param01(bartot01).bar_Caption01)) Then
                        bar_param01(bartot01).bar_Exist01 = 1
                        toolbar_Add = bar01
                    End If
                Next

                '=== add tolbar if not already there
                If bar_param01(bartot01).bar_Exist01 = 0 Then
                    '=== we are in outlook main window
                    toolbar_Add = inspectororexplorer01.CommandBars.Add(bar_param01(bartot01).bar_Caption01)
                End If

                '=== make toolbar visible
                If Not toolbar_Add Is Nothing Then
                    'MsgBox("bar added")
                    toolbar_Add.Name = bar_param01(bartot01).bar_Caption01
                    toolbar_Add.Visible = True
                    If bar_param01(bartot01).bar_Exist01 = 0 Then
                        toolbar_Add.Position = Office.MsoBarPosition.msoBarTop
                    End If

                    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                    ' button(s)
                    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                    For buttot01 = 0 To buttoncnt

                        'Dim button_Add As Office.CommandBarButton
                        '=== add a button in a toolbar
                        '=== the bar to add the button to is in the parameters structure

                        Dim button02 As Office.CommandBarButton
                        Dim dontadd01 As Integer = 0

                        '=== delete all buttons in bar
                        For Each button02 In toolbar_Add.Controls 'but_param01(buttot01).but_bar01.Controls
                            '=== no more delete all, we simply delete old buttons we dont want anymore
                            If LCase(but_param01(buttot01).but_Caption01) = LCase(button02.Caption) Then
                                dontadd01 = 1
                                Exit For
                            End If
                            If button02.Caption = "a effacer" Then
                                'button02.Delete()
                            End If
                        Next

                        '=== button add

                        If dontadd01 <> 1 Then
                            button02 = inspectororexplorer01.CommandBars(toolbar_Add.Name).Controls.Add(Type:=Office.MsoControlType.msoControlButton, Before:=1)

                            If Not button02 Is Nothing Then
                                With button02
                                    'buttons(depnum, 0)

                                    .Caption = but_param01(buttot01).but_Caption01
                                    .TooltipText = but_param01(buttot01).but_tooltip01
                                    .Enabled = True
                                    .Visible = True
                                    .OnAction = but_param01(buttot01).but_onaction01
                                    '.OnAction = "!<" &  & ">"
                                    .Tag = but_param01(buttot01).but_Caption01
                                    .Style = Office.MsoButtonStyle.msoButtonIconAndCaption
                                    .FaceId = but_param01(buttot01).but_face01

                                    'Dim Icon01 = LoadPicture("C:\_outlook\icon.bmp")
                                End With
                                '=== add event only in explorer (not in inspector)
                                'Microsoft.Office.Interop.Outlook.Inspector
                                'Globals.ThisAddIn.Application.ActiveExplorer
                                If TypeOf inspectororexplorer01 Is Outlook.Explorer Then
                                    If but_param01(buttot01).but_Caption01 = but_param01(2).but_Caption01 Then
                                        '=== copy hyerlink to open item or selected item(s)
                                        glovar.button02 = button02
                                        AddHandler glovar.button02.Click, AddressOf copierhyperlien01
                                        'MsgBox("event added")
                                    End If

                                    If but_param01(buttot01).but_Caption01 = but_param01(1).but_Caption01 Then
                                        '=== copy item in contract folder
                                        '=== delete item (send to deleted items)
                                        glovar.button01 = button02
                                        AddHandler glovar.button01.Click, AddressOf classeritem01
                                    End If

                                    If but_param01(buttot01).but_Caption01 = but_param01(0).but_Caption01 Then
                                        '=== help about this addin
                                        glovar.button00 = button02
                                        AddHandler glovar.button00.Click, AddressOf aide01
                                    End If

                                Else
                                    '=== no event definition
                                End If
                            Else
                                '=== button not created
                            End If
                        Else
                            '=== the button was already there
                        End If
                    Next
                Else
                    '=== toolbar not created
                End If
            Else
                '=== there was no toolbars anywhere?
            End If

            '=== there was no inspectors (message) or explorer opened at the startup of outlook
        Next

        Return 0
    End Function
    Private Sub aide01(ByVal ctrl As Office.CommandBarButton, ByRef Cancel As Boolean)
        Dim msg01 As String = ""
        msg01 = msg01 & "Aide Help" & vbCrLf & vbCrLf
        msg01 = msg01 & "Par: Serge Fournier (sergefournier@hotmail.com)" & vbCrLf
        msg01 = msg01 & "The version is in DLL properties" & vbCrLf & vbCrLf
        msg01 = msg01 & "(C) 2017-02-05" & vbCrLf
        MsgBox(msg01)

    End Sub

    Private Sub classeritem01(ByVal ctrl As Office.CommandBarButton, ByRef Cancel As Boolean)
        'Microsoft.Office.Interop.Outlook.Inspector
        'Globals.ThisAddIn.Application.ActiveExplorer
        MsgBox("classer item")
        '''''''''''''''''''''''''''''''''
        ' the mail is open in inspector
        '''''''''''''''''''''''''''''''''
        Dim inspector01 As Microsoft.Office.Interop.Outlook.Inspector
        inspector01 = Globals.ThisAddIn.Application.ActiveInspector

        Dim item01(0) As Object
        Dim item01ismailininspector = 0

        If Not inspector01 Is Nothing Then
            Try
                '=== check the actual openned item, if it does not exist, then there is no mail open at the moment
                item01(0) = inspector01.CurrentItem
                item01ismailininspector = 1
            Catch ex As Exception
                '=== no item is openned, we create one later
                item01(0) = Nothing
            End Try
        Else
            '=== no inspector, that mean there is no item opened
        End If

        Dim itemcnt = 0

        If item01ismailininspector = 0 Then
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' get all selected items in explorer (not inspector, wich would be an open item)
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            '=== selected items in explorer window
            Dim explorer01 = Globals.ThisAddIn.Application.ActiveExplorer
            Dim selection01 = explorer01.Selection

            For Each item02 In selection01
                ReDim Preserve item01(itemcnt)
                item01(itemcnt) = item02
                itemcnt = itemcnt + 1
            Next
            itemcnt = itemcnt - 1
            'MsgBox(selection01.Count)

        Else
            '=== the item is open right now in inspector
            '=== we have only one item to process: item01(0)
        End If


        For i = 0 To itemcnt

            If TypeOf item01(i) Is Outlook.MailItem Then
                Dim item02 As Outlook.MailItem
                item02 = item01(i)
                '=== look for any project code in item object 999000 (client 999, project 000)
                Dim object01 As String
                object01 = item02.Subject

                Dim projectid01 As String
                projectid01 = find_projet(object01, "######")

                MsgBox("projectid01: " & projectid01)

                '=== look for any project code in item content

            ElseIf TypeOf item01(i) Is Outlook.TaskItem Then

            ElseIf TypeOf item01(i) Is Outlook.ReportItem Then

            ElseIf TypeOf item01(i) Is Outlook.ContactItem Then

            End If




        Next

    End Sub
    Private Function find_projet(text01 As String, mask01 As String) As String
        Dim projectid01 As String = ""
        If Len(text01) >= Len(mask01) Then
            Dim found01 = 0
            Dim char01 As String
            Dim char02 As String
            Dim totfound01 As Integer = 0
            Dim i As Integer = 0
            While totfound01 < Len(mask01) And i < Len(text01)

                char01 = Mid(text01, i + 1, 1)
                Dim i2 As Integer = 0
                While totfound01 < Len(mask01) And i2 < Len(mask01)

                    char02 = Mid(mask01, i2 + 1, 1)
                    '=== find number sequence for project id
                    If char02 = "#" Then
                        If InStr(char01, "0123456789") <> 0 Then
                            totfound01 = totfound01 + 1
                            projectid01 = projectid01 & char01
                        Else
                            totfound01 = 0
                            projectid01 = ""
                        End If
                        i2 = i2 + 1
                    End If
                End While
                i = i + 1
            End While

        Else
            projectid01 = ""
        End If

        Return projectid01
    End Function
End Class