Per VB Adressen auslesen

Dim oApp As DvApi32.IApplication
Dim oAcc As DvApi32.Account
Dim oArch As DvApi32.Archive
Dim oAddress As DvApi32.AddressItem
Dim lngAdressen As Long


Public Const DIRDATEI = "c:\temp\tobit.dir"


Private Sub LeseUnterordner(ByRef Ordner As DvApi32.Archive)
  On Error Resume Next
  Dim intItemNr As Integer
  Dim oOrdner As DvApi32.Archive
  intItemNr = 0
  For Each oOrdner In Ordner.Archives
      LeseUnterordner oOrdner
      LeseAdressen oOrdner
  Next oOrdner
End Sub


Private Sub LeseAdressen(ByRef Ordner As DvApi32.Archive)
  On Error Resume Next
  Dim oAdressen As DvApi32.AddressItem
  Dim lngFile As Long

'  frmSync.lstSync.AddItem "Ordner: " & Ordner.FullPath
'  DoEvents

  lngFile = FreeFile
  Open DIRDATEI For Append As #lngFile

  For Each oAdressen In Ordner.AllItems
      lngAdressen = lngAdressen + 1
      Print #lngFile, Replace(Ordner.FullPath & "^" & oAdressen.FirstName & "^" & oAdressen.MiddleInitial & "^" & oAdressen.LastName & "^" & _
                      oAdressen.DisplayName & "^" & oAdressen.Salutation & "^" & oAdressen.Title & "^" & oAdressen.Birthday & "^" & _
                      oAdressen.Company & "^" & oAdressen.Street & "^" & oAdressen.ZipCode & "^" & oAdressen.City & "^" &  _
                      oAdressen.Country & "^" & oAdressen.State & "^" &                        Adressen.WebSite & "^" & oAdressen.PhoneOffice & "^" & _
                      oAdressen.PhonePrivate & "^" & oAdressen.PhoneMobile & "^" & _
                      oAdressen.Email & "^" & oAdressen.AltEMail & "^" & oAdressen.FaxNumber & "^" & oAdressen.AltFaxNumber & "^" & _
                      oAdressen.VoiceBox & "^" & oAdressen.SMSNumber & "^" & oAdressen.Notes & "^" & oAdressen.Category, vbCrLf, " ")
  Next oAdressen

  Close #lngFile
End Sub


Public Sub Sync2Tobit()
  On Error Resume Next
  Set oApp = CreateObject("DVOBJAPILib.DvISEAPI")
  Set oAcc = oApp.Logon("", "", "", "", "", "AUTH")
  Set oArch = oAcc.GetSpecialArchive(DvApi32.DvArchiveTypes.DvArchiveAddress)


  lngAdressen = 0
  Kill DIRDATEI

  frmSync.Show vbModeless
  frmSync.MousePointer = fmMousePointerHourGlass
  DoEvents

  LeseUnterordner oArch
  LeseAdressen oArch

  frmSync.MousePointer = fmMousePointerDefault
Abbruch:
  Unload frmSync
End Sub