Outlook Adressbuch - Import per vbs

Set oWSHNetwork = CreateObject("WScript.Network")  
sUser = oWSHNetwork.UserName

If sUser = "test" Then  


'Deklarationen  
'-------------------------------------------------------------------------------------------------  
Set oOutlook = CreateObject("Outlook.Application")  
Set oNameSpace = oOutlook.GetNamespace("MAPI")  
Set oFolderpath = oOutlook.GetNamespace("MAPI")  
Set oListFolder = oNameSpace.Folders("Persönliche Ordner")  

Dim arrbooks(1)
arrbooks(0) = ("Adressbuch")  


pstpath = "X:\adressbook.pst"  

lcount = 0

'Funktion zum erstellen des Pfades in dem das Adressbuch liegt.  
'-------------------------------------------------------------------------------------------------  
Function cpath(itemname, pathname)

For Each item In oListFolder.Folders
    pos=Instr(item, itemname)
    if pos > 0 Then
    fpath = (item.folderpath)
    Exit for
    end If
Next

If fpath = "" Then  
exit Function
End If

fpath = Right(fpath, Len(fpath) - 2)
parray = Split(fpath, "\")  

For Each item In parray
Set oFolderpath = oFolderpath.folders(item)
Next

Set pathname = oFolderpath

Set oFolderpath = oOutlook.GetNamespace("MAPI")  
Set parray = Nothing

End Function

Do Until lcount = 1
Set fs = CreateObject("Scripting.FileSystemObject")  
If fs.DriveExists("P:") Then  
lcount = 1
End If
Set fs = Nothing
loop

'Bestehende Adressbücher deaktivieren & löschen  
'-------------------------------------------------------------------------------------------------  
cpath "Adressbuch", bbgab  

If Not bbgab = "" Then  

bookcount = bbgab.folders.count
If bookcount < 12 Then
MsgBox ("Die Struktur des Adressbuches wurde verändert. Melden Sie sich beim Support!")  
WScript.Quit
End if

bbgab.showasoutlookab = False

For count = 1 To UBound(arrbooks,1) -1
bbgab.folders(arrbooks(count)).showasoutlookab = False
Next

bbgab.delete()
oNameSpace.Folders("Persönliche Ordner").Folders("Gelöschte Objekte").Folders("Adressbuch").delete()  

End if

'Import von Adressbuch aus PST  
'-------------------------------------------------------------------------------------------------  
oNameSpace.AddStore(pstpath)

Set oKontaktordner = oNameSpace.Folders("Adressbuch").Folders("Adressbuch")  
Set oDestination = oNameSpace.Folders("Persönliche Ordner")  
oKontaktordner.CopyTo(oDestination)

oNameSpace.RemoveStore oNameSpace.Folders("Adressbuch")  

'Aktivieren der Adressbücher  
'-------------------------------------------------------------------------------------------------  
cpath "Adressbuch", bbgab  
bbgab.showasoutlookab = True
For count = 1 To UBound(arrbooks,1) -1
bbgab.folders(arrbooks(count)).showasoutlookab = True
Next

End if