OLTimeStampImport

Outlook : TimeStamp Import

TimeStamp est un superbe logiciel de suivi de temps.

Je diffuse ici le moyen d'importer dans Outlook les fichiers exportés au format ASCII de ce superbe software.

Sub TimeStamp_ImportASCII()
'================================================================================
' Import TimeStamp ASCII File in the current Ouytlook Folder
'
' Author    : Fabrice Vado
' Date      : 20080121
'================================================================================


Const CST_FileName = "C:\Documents and Settings\fvado\Mes documents\TimeStamp\20080103-21.txt"

' Constant
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const CST_TaskNumber = 0, CST_StartTime = 1, CST_EndTime = 2, CST_TotalTime = 3, _
    CST_SlackTime = 4, CST_WorkTime = 5, CST_HourlyRate = 6, CST_WorkCost = 7, CST_Notes = 8

Dim sFileName       As String
Dim oFSO, TSFile, arrTSLine
                    
Dim appolApp As Outlook.Application
Dim olApptItem As Outlook.AppointmentItem
    

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    sFileName = InputBox("Insert path of the TimeStamp ASCII file :", "TimeStamp Import", CST_FileName)

    If Len(Trim(sFileName)) > 0 Then
        Set TSFile = oFSO.OpenTextFile(sFileName, ForReading, True)
        
        ' Jump header
        arrTSLine = Split(TSFile.ReadLine, vbTab)
        
        ' Loop in file
        Do While Not TSFile.AtEndOfStream
        
            ' Load the line from the file
            arrTSLine = Split(TSFile.ReadLine, vbTab)
            
            ' Create the appointment in CURRENT Folder
            Set olApptItem = ActiveExplorer.CurrentFolder.Items.Add(olAppointmentItem)
            With olApptItem
                .Subject = arrTSLine(CST_Notes)
                .Start = arrTSLine(CST_StartTime)
                .End = arrTSLine(CST_EndTime)
                .Save
            End With
            Set olApptItem = Nothing
    
        Loop
    
        TSFile.Close
        Set TSFile = Nothing
    
    End If
    
    Set oFSO = Nothing


End Sub