Module Module1
Sub export()
Dim objIniFile As New IniFile(Environment.CurrentDirectory() & "\" & "conf.ini")
Dim uid As String
uid = objIniFile.GetString("CONFIGURATION", "uid", "")
Dim server As String
server = objIniFile.GetString("CONFIGURATION", "serverPath", "")
Dim myOlApp As Outlook.Application
Dim tdystart As String
Dim tdyend As String
Dim myAppointmentsForDel As Outlook.Items
Dim str As String = " "
Dim dataArray(5) As String
Dim OleDbConn1 As OleDbConnection
Dim ConStr As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\" & server & "\CustData\lgebase\App_Data\db_Klanten_reserve2.mdb;Jet OLEDB:Database Password=marionils;"
Dim SqlStr As String
Dim Cmd As New OleDbCommand
Dim dsCalendar As New DataSet
Dim myDataAdapter As OleDbDataAdapter
Dim AppAlreadyIn As Boolean = False
Dim curRow As Integer = 0
If My.Computer.Network.IsAvailable = True Then
If My.Computer.Network.Ping(server, 3000) Then
'myNameSpace.Logon("Mario Van den Eynde", Missing.Value, False, True)
tdystart = Now.AddDays(-1).Day & "-" & Now.Month & "-" & Now.Year
tdyend = Now.AddDays(7).Day & "-" & Now.Month & "-" & Now.Year
'tdystart = Now.Month & "/" & Now.AddDays(-5).Day & "/" & Now.Year
'tdyend = Now.Month & "/" & Now.AddDays(5).Day & "/" & Now.Year
'
'
'*** [DATABASE: GET ALL APPOINTMENTS FROM CURRENT USER ] ***
Console.WriteLine("*** [DATABASE: GET ALL APPOINTMENTS FROM CURRENT USER ] ***")
SqlStr = "select PK_Afspraak,AfspraakStart,AfspraakEnd,AfspraakOnderwerp,AfspraakMemo,AfspraakClientID,FK_Medewerker from tblAfspraak where FK_Medewerker =" & uid & " and AfspraakStart > " & tdystart & ";"
myDataAdapter = New OleDbDataAdapter(SqlStr, ConStr)
myDataAdapter.Fill(dsCalendar, "tblAfspraak")
Console.WriteLine("*** [ END ] ***")
'*** [ END ] ***
'
'*** [CLIENTPC: GET ALL APPOINTMENTS FROM CURRENT USER ] ***
Console.WriteLine("*** [CLIENTPC: GET ALL APPOINTMENTS FROM CURRENT USER ] ***")
myOlApp = CreateObject("Outlook.Application")
Dim olNs As Outlook.NameSpace
olNs = myOlApp.GetNamespace("MAPI")
olNs.Logon("Outlook", Missing.Value, False, True)
Dim myAppointments = olNs.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar).Items
Dim currentAppointment = myAppointments
myAppointmentsForDel = currentAppointment
myAppointments.Sort("[Start]")
myAppointments.IncludeRecurrences = True
currentAppointment = myAppointments.Find("[Start] >= """ & tdystart & """ and [Start] <= """ & tdyend & """")
'*** [ END ] ***
'
'*** [CONNECTION: OPEN CONNECTIONS AND LOOPS ] ***
OleDbConn1 = New OleDbConnection(ConStr)
OleDbConn1.Open()
Console.WriteLine("*** [Connection opened and ready for loops ] ***")
While TypeName(currentAppointment) <> "Nothing"
Console.WriteLine(" *** [ There is an appointment ] ***")
For curRow = 0 To dsCalendar.Tables(0).Rows.Count - 1
Console.WriteLine(" *** [ We are in the for curRow loop ] ***")
Console.WriteLine(" *** [ " & currentAppointment.EntryID.ToString & "=" & dsCalendar.Tables(0).Rows(curRow).Item(5).ToString() & " ] ***")
If currentAppointment.EntryID.ToString = dsCalendar.Tables(0).Rows(curRow).Item(5).ToString() Then
Console.WriteLine(" *** [ THE SAME! ] ***")
AppAlreadyIn = True
Exit For
End If
Next
If Not AppAlreadyIn Then
Console.WriteLine(" *** [ Not yet inserted before, INSERT now] ***")
Console.WriteLine(currentAppointment.Start.ToString)
Console.WriteLine(currentAppointment.End.ToString)
Console.WriteLine(currentAppointment.Subject.ToString)
Console.WriteLine(currentAppointment.EntryID)
dataArray(0) = IIf(IsDBNull(currentAppointment.Start.ToString), "", currentAppointment.Start.ToString)
dataArray(1) = IIf(IsDBNull(currentAppointment.End.ToString), "", currentAppointment.End.ToString)
dataArray(2) = IIf(IsDBNull(currentAppointment.Subject.ToString), "No subject specified.", currentAppointment.Subject.ToString)
dataArray(3) = IIf(currentAppointment.Body Is Nothing, "No messagebody filled in.", currentAppointment.Body)
'dataArray(3) = ""
dataArray(4) = currentAppointment.EntryID
dataArray(5) = uid
SqlStr = "INSERT into tblAfspraak (AfspraakStart,AfspraakEnd,AfspraakOnderwerp,AfspraakMemo,AfspraakClientID,FK_Medewerker) values ('" & dataArray(0) & "', '" & dataArray(1) & "', '" & dataArray(2) & "', '" & dataArray(3) & "', '" & dataArray(4) & "', " & dataArray(5) & ");"
'MsgBox("Ingevoerde query: " & SqlStr)
Cmd = New OleDbCommand(SqlStr, OleDbConn1)
Cmd.ExecuteNonQuery() 'This command will insert the data.
Console.WriteLine("***** [ DATA INSERTED! ] ***** ")
Else
Console.WriteLine(currentAppointment.Start.ToString)
Console.WriteLine(currentAppointment.End.ToString)
Console.WriteLine(currentAppointment.Subject.ToString)
Console.WriteLine(currentAppointment.EntryID)
dataArray(0) = IIf(IsDBNull(currentAppointment.Start.ToString), "", currentAppointment.Start.ToString)
dataArray(1) = IIf(IsDBNull(currentAppointment.End.ToString), "", currentAppointment.End.ToString)
dataArray(2) = IIf(IsDBNull(currentAppointment.Subject.ToString), "No subject specified.", currentAppointment.Subject.ToString)
dataArray(3) = IIf(currentAppointment.Body Is Nothing, "No messagebody filled in.", currentAppointment.Body)
'dataArray(3) = ""
dataArray(4) = currentAppointment.EntryID
dataArray(5) = uid
SqlStr = "Update tblAfspraak set AfspraakStart='" & dataArray(0) & "', AfspraakEnd='" & dataArray(1) & "' , AfspraakOnderwerp='" & dataArray(2) & "' , AfspraakMemo='" & dataArray(3) & "' , AfspraakClientID='" & dataArray(4) & "' , FK_Medewerker=" & dataArray(5) & " where PK_Afspraak=" & dsCalendar.Tables(0).Rows(curRow).Item(0).ToString & ";"
Cmd = New OleDbCommand(SqlStr, OleDbConn1)
Cmd.ExecuteNonQuery() 'This command will insert the data.
Console.WriteLine("***** [ DATA UPDATED! ] ***** ")
If CType(currentAppointment.Start, DateTime).Day < CType(currentAppointment.End, DateTime).Day Then
currentAppointment = myAppointments.FindNext
End If
End If
AppAlreadyIn = False
currentAppointment = myAppointments.FindNext
End While
Console.WriteLine(" ")
'*** [ END VGL APPOINTMENTS IN DB WITH CLIENT ] ***
'
'*** [ START VGL DELETED APP. ON CLIENT WITH DB ] ***
Console.WriteLine("*** [ START VGL DELETED APP. ON CLIENT WITH DB ] ***")
Dim delArray As New ArrayList()
Dim delArrayIndex As Integer = 0
For curRow = 0 To dsCalendar.Tables(0).Rows.Count - 1
Console.WriteLine(" *** [ We are in the for loop: " & dsCalendar.Tables(0).Rows(curRow).Item(5).ToString() & " ] ***")
'Console.WriteLine(" *** [ " & currentAppointment.EntryID.ToString & "=" & dsCalendar.Tables(0).Rows(curRow).Item(5).ToString() & " ] ***")
Try
Dim deleteItem As Outlook.AppointmentItem
If dsCalendar.Tables(0).Rows(curRow).Item(5).ToString() <> "" Then
deleteItem = myOlApp.Session.GetItemFromID(dsCalendar.Tables(0).Rows(curRow).Item(5).ToString())
Dim par = deleteItem.Parent
If par.Name <> "Calendar" Then
Console.WriteLine(" *** [ There is a app in the DB that is NOT on the clients calendar ] ***")
delArray.Add(dsCalendar.Tables(0).Rows(curRow).Item(5).ToString())
delArrayIndex = delArrayIndex + 1
End If
deleteItem = Nothing
par = Nothing
Else
Dim id As String
' Create a new AppointmentItem.
Dim oAppt As Outlook.AppointmentItem = myOlApp.CreateItem(Outlook.OlItemType.olAppointmentItem)
' Set some common properties.
oAppt.Start = dsCalendar.Tables(0).Rows(curRow).Item(1).ToString()
oAppt.End = dsCalendar.Tables(0).Rows(curRow).Item(2).ToString()
oAppt.Subject = dsCalendar.Tables(0).Rows(curRow).Item(3).ToString()
oAppt.Body = dsCalendar.Tables(0).Rows(curRow).Item(4).ToString()
oAppt.Save()
id = oAppt.EntryID
Console.WriteLine("id=" & id)
SqlStr = "Update tblAfspraak set AfspraakClientID='" & id & "' where PK_Afspraak=" & dsCalendar.Tables(0).Rows(curRow).Item(0).ToString & ";"
Cmd = New OleDbCommand(SqlStr, OleDbConn1)
Cmd.ExecuteNonQuery() 'This command will insert the data.
Console.WriteLine("***** [ APP CREATED AND DB IS UPDATED! ] ***** ")
oAppt = Nothing
End If
Catch er As SyntaxErrorException
MsgBox("er ging iets fout!" & er.Message)
End Try
Next
Dim strWhere As String = ""
For delArrayIndex = 0 To delArray.Count - 1
If delArrayIndex = 0 Then
strWhere = strWhere & " where (AfspraakClientID='" & delArray(delArrayIndex) & "'"
Else
strWhere = strWhere & " or AfspraakClientID='" & delArray(delArrayIndex) & "'"
End If
Next
If strWhere <> "" Then
strWhere = strWhere & ");"
SqlStr = "delete from tblAfspraak" & strWhere
Cmd = New OleDbCommand(SqlStr, OleDbConn1)
Cmd.ExecuteNonQuery() 'This command will insert the data.
End If
Console.WriteLine("*** [ END VGL DELETED APP. ON CLIENT WITH DB ] ***")
'myOlApp()
'myAppointmentsForDel
'OleDbConn1()
'Cmd()
'dsCalendar()
'myDataAdapter()
'myAppointments()
'currentAppointment()
'deleteItem()
'par()
'oAppt()
myOlApp.Quit()
myOlApp = Nothing
myAppointmentsForDel = Nothing
myAppointments = Nothing
olNs.Logoff()
MsgBox("Your calendar has been updated!")
dsCalendar.Dispose()
dsCalendar = Nothing
Cmd.Dispose()
Cmd = Nothing
OleDbConn1.Close()
OleDbConn1.Dispose()
OleDbConn1 = Nothing
myDataAdapter.Dispose()
myDataAdapter = Nothing
Else
MsgBox("No connection available with the server...")
End If
Else
MsgBox("No connection available...")
End If
End Sub
