Få excel til et oprette Outlook-taks der sendes til en kollega.
Med referece til et tidligere spørgsmål http://www.eksperten.dk/spm/1010028 der nu er afsluttet, så opretter min excel-VBA-automatisering nogle tasks i min egen Outlook.Jeg lavede en løsning kraftigt inspireret en det jeg fandt på mrexcelguru.com:
På siden http://mrexcelguru.com/create-tasks-in-outlook-from-excel/ er der et link til en fil der kan hentes ned, og den hjalp mig med en løsning der virker.
Jeg poster lige koden her også:
Bemærk at den er delt i to procedurer og én function der kalder hinanden.
Sub Transfer()
Dim BatchNrCol As Integer
Dim BatchEndDateCol As Integer ' variabel til hvilken kolonne har jeg batchenes slutdatoer
Dim TaskCreatedCol As Integer ' variabel til hvilken kolonne vil jeg markere at OutlookTask er genereret
Dim TaskSubjectStr As String
Dim BatchStr As String
Dim DueDate As Date
BatchNrCol = 1
BatchEndDateCol = Cells(1, SLUTDATOER_ML).Column + 2
TaskCreatedCol = BatchEndDateCol + 15
RowNr = FindActualBatch("I") ' jeg kalder en function der finder rækken med den igangværende batch.
BatchStr = Cells(RowNr, BatchNrCol)
DueDate = Cells(RowNr, BatchEndDateCol).Value
' tjekker om der allerede er oprettet task
If Not Cells(RowNr, TaskCreatedCol).Value = "OutlookTask Created" Then
' hvis ikke så opretter vi en task
TaskSubjectStr = "Kontroller slutprøver fra IA-batch " & BatchStr & ", og bestil rengøringshold til næste gang"
Cells(RowNr, TaskCreatedCol).Value = "OutlookTask Created"
Call AddTask(TaskSubjectStr, DueDate)
End If
End Sub
Dim olApp As Object
Dim objTask As Object
'Start Outlook if not started
On Error Resume Next ' deaktverer fejlmedd.
Set olApp = GetOutlookApp ' funktionskald der tjekker om outlook er åben - ellers åbner vi outlook
On Error GoTo 0
If Not olApp Is Nothing Then
Set objTask = olApp.CreateItem(3) ' generer en ny Task
With objTask ' sætter nogle egenskaber i task'en
.StartDate = dDueDate ' startdato - bruger samme som slutdato
.DueDate = dDueDate
.Subject = sString
.Save ' springer diaplay over og går direkte til gem
End With
End If
If bWeStartedOutlook Then
olApp.Quit
End If
Set olApp = Nothing
Set objTask = Nothing
End Sub
' function tjekker om Outlook er åben ellers åbner vi Outlook
On Error Resume Next
Set GetOutlookApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set GetOutlookApp = CreateObject("Outlook.Application")
bWeStartedOutlook = True
End If
On Error GoTo 0
End Function
Spørgsmål:
Kan jeg lave en udgave der sender den oprettede Task til en kolega ?