Option Explicit

Const SQDB     As String = "C:\temp\contacts.sqdb"
Const SQLfile  As String = "C:\temp\contacts.sql"
Const SQLITE   As String = "C:\temp\sqlite3.exe"

Sub ContactsToSQDB()
Dim sqlCmd As String
Dim retval As Double

  retval = MsgBox("Overwrite existing " & SQLfile & " (if exists)?", _
           vbQuestion + vbYesNo)
  
  If retval = vbYes Then
    Call ContactsToSQL
  End If
    
    sqlCmd = SQLITE _
        & " -echo " _
        & SQDB _
        & " "".read " _
        & Replace(SQLfile, "\", "\\") _
        & """"
  
  retval = MsgBox("OK to generate PhonebookDB?" & vbCrLf & vbCrLf & sqlCmd, _
           vbQuestion + vbYesNo)
  
  If retval = vbYes Then
  
      'sqlite3.exe -echo temp.db ".read c:\\temp\\contacts.txt"
      retval = Shell(sqlCmd, vbNormalFocus)
      
  End If

End Sub

Sub ContactsToSQL()

  Dim olApp     As Outlook.Application
  Dim objName   As Outlook.NameSpace
  Dim myFolder  As Outlook.MAPIFolder
  Dim myItems   As Outlook.Items
  Dim myItem    As Object
  
  Dim txtQual   As String
  Dim numQual   As Integer

  Set olApp = Outlook.Application
  Set objName = olApp.GetNamespace("MAPI")
  Set myFolder = objName.PickFolder()
  'Set myFolder = objName.GetDefaultFolder(olFolderContacts)
  'Set myFolder = myFolder.Folders("Contactpersonen")
    
  Set myItems = myFolder.Items
  myItems.Sort "[FullName]", False

  Open SQLfile For Output As #1

  On Error Resume Next

 'Print #1, ".echo on"
  Print #1, "drop table phonebook;"
  Print #1, "CREATE TABLE phonebook"
  Print #1, "  (ID           INTEGER PRIMARY KEY,"
  Print #1, "   chShowName   TEXT,"
  Print #1, "   chPhoneCode  TEXT,"
  Print #1, "   dwType       INTEGER"
  Print #1, "  );"
  Print #1, "BEGIN TRANSACTION;"
  
  For Each myItem In myItems
    If InStr(1, myItem.Categories, "dont-export") = 0 Then
    
      txtQual = Left(Trim(myItem.HomeTelephoneNumber), 1) _
              & Left(Trim(myItem.MobileTelephoneNumber), 1) _
              & Left(Trim(myItem.BusinessTelephoneNumber), 1)
              
      numQual = 0: If Len(txtQual) > 1 Then numQual = 1
    
      Call PrintSQLElement(myItem.FullName, myItem.HomeTelephoneNumber, numQual * 1)
      Call PrintSQLElement(myItem.FullName, myItem.MobileTelephoneNumber, numQual * 2)
      Call PrintSQLElement(myItem.FullName, myItem.BusinessTelephoneNumber, numQual * 3)
    
    End If
  Next myItem
      
  Print #1, "COMMIT;"
  Close #1

End Sub

Private Sub PrintSQLElement(Name, Phone, qualifier)
  Phone = Replace(Phone, " ", "")
  Name = Replace(Name, "'", "''")
  If Len(Phone) > 0 Then
    Print #1, "insert into 'phonebook' " _
            & "values(Null,'" & Name & "','" & Phone & "'," & qualifier & ");"
  End If
End Sub