Salve a tutti, è da oggi pomeriggio che non vado avanti perchè sono bloccato con l'insert in calendario eventi di outllok di record che estrapolo da access. Di seguito posto il codice ed ho evidenziato in rosso le righe che mi danno proiblemi, in pratica non so come passare la data al calendario di outllo, ho provato in 1000000 di modi ma lui prende sempre la data del 30 dicembre 1899, grazie per l'aiuto:
Public Sub ImportaDatiCalendario()
' The Outlook application model
Dim objOutlook As Outlook.Application
' The Outlook namespace for accessing folders
Dim objNamespace As Outlook.NameSpace
' An Outlook folder; will be the calendar
Dim objFolderCalendar As Outlook.MAPIFolder
' An appointment; remember to save it when done!
Dim newAppt As Outlook.AppointmentItem
Set objOutlook = Outlook.Application
' Get the Outlook namespace so you can access folders
Set objNamespace = objOutlook.GetNamespace("MAPI")
' Get the calendar folder
Set objFolderCalendar = objNamespace.GetDefaultFolder(olFolderCalendar)
'Create a new appt.
Set newAppt = objFolderCalendar.Items.Add
Dim rstDati As Recordset
Set rstDati = CurrentDb.OpenRecordset("SELECT T_Appuntamenti.Oggetto, T_Appuntamenti.Nome, T_Appuntamenti.Cognome, T_Appuntamenti.DataAppuntamento, Min(T_Appuntamenti.OraAppuntamento) AS MinDiOraAppuntamento, T_Appuntamenti.Progressivo, Max(T_Appuntamenti.OraAppuntamento) AS MaxDiOraAppuntamento FROM T_Appuntamenti GROUP BY T_Appuntamenti.Oggetto, T_Appuntamenti.Nome, T_Appuntamenti.Cognome, T_Appuntamenti.DataAppuntamento, T_Appuntamenti.Progressivo HAVING (((T_Appuntamenti.DataAppuntamento)>=Date()))")
Dim dataitaliaStart As Date
Dim dataitaliaEnd As Date
Dim GiornoItalia As String
Dim MeseItalia As String
Dim AnnoItalia As String
Dim dataamerica As Date
Do While Not rstDati.EOF
Set newAppt = objFolderCalendar.Items.Add
'RECUPERO I DATI DAL RECORDSET
dataitaliaStart = Format(rstDati.Fields("DataAppuntamento").Value, "dd/mm/yyyy")
dataitaliaEnd = Format(rstDati.Fields("DataAppuntamento").Value, "dd/mm/yyyy")
' FORMATTO LA DATA IN TIPOLOGIA AMERICANA
MeseItalia = Mid(dataitaliaStart, 4, 2)
GiornoItalia = Mid(dataitaliaStart, 1, 2)
AnnoItalia = Right(dataitaliaStart, 4)
dataamerica = MeseItalia & "/" & GiornoItalia & "/" & AnnoItalia
newAppt.Start = xxxxxx
newAppt.End = xxxxxxx
newAppt.Subject = rstDati.Fields("Oggetto").Value
newAppt.StartInStartTimeZone = rstDati.Fields("MinDiOraAppuntamento").Value
newAppt.EndInEndTimeZone = rstDati.Fields("MaxDiOraAppuntamento").Value
'set more properties
' actually save it in Outlook
newAppt.Save
' clear the VBA object so you can use it again the next time around the loop
Set newAppt = Nothing
rstDati.MoveNext
Loop
End Sub
Rispondi quotando
Originariamente inviata da devil946
