问题描述
您好，我是
我正在尝试将Excel 2013年的文本导入每周一次到Exchange日历（不是我自己的Outlook）。我尝试在Outlook中使用导入/导出功能，但这不可靠且太麻烦，因为它不会导入到基于服务器的日历，
只有我自己加上csv中有逗号和分号的问题为德国MS Office。所以我试图尝试VB脚本，我觉得很复杂。
Hello,
I'm trying to Import Text from an Excel 2013 Sheet weekly to an Exchange Calender (Not my own Outlook). I have tried using the Import/Export function in Outlook but this is not reliable and too cumbersome because it won't Import to Server based Calender, only my own plus there are Problems with the comma and semi-colon in csv for German MS Office. So I have resorted to try out VB Script, which I find complicated.
我已经尝试了以下脚本，但一直收到错误"与主题的约会：第2行中的xxxx无效：缺少时间"。我认为偏移是错误的，但我看不到哪里，所以我不断改变它无济于事。我的Office 2013是德语
，但我被告知与VB没有任何区别？此外，在将其导入Exchange日历时，我认为我需要另外一行代码，例如：或类似的东西：
设置objAppt = newCalFolder.Items.Add（olAppointmentItem）
I have tried the below script but keep getting the error "The Appointment with the Subject: xxxx in row 2 is Invalid: Missing Times". I think the Offsets are wrong but I can't see where so I keep changing it around to no avail. My Office 2013 is in German but I am told that doesn't make any difference with VB? Also, in oder to Import it to an Exchange calender I think I Need another line of code like this or something similar:Set objAppt = newCalFolder.Items.Add(olAppointmentItem)
我无法上传Excel工作表的图片，因为我的帐户尚未经过验证。所以这基本上就是我需要的：
I wasn't able to upload a pic of the Excel sheet because my account is not yet verified. So here is basically what I Need:
标题：A1 - " RFC Number" | B1 - 标题| C1 - 描述| D1 - 日期来自| E1 - 日期到| F1 - 来自|的时间G1-时间
Header: A1 - "RFC Number" | B1 - Title | C1 - Description | D1 - Date from | E1 - Date to | F1 - Time from | G1- Time to
第2,3,4行...... 是文本。
Row 2, 3, 4 etc.. is the Text.
任何帮助都将非常感谢到目前为止，我已经花了很长时间。
$
子创建预约（）
出错时继续下一个
Dim sheet As Worksheet，rngStart As Range，rngEnd As Range，cell as Range
设置objOL = CreateObject（" Outlook.Application"）
设置objCal = objOL .Session.GetDefaultFolder（9）
设置表=工作表（1）
设置rngStart = sheet.Range（" A2"）
设置rngEnd = rngStart.End（xlDown）
counter = 0
For each cell in sheet.Range（rngStart，rngEnd）
设置olApp = objCal.Items.Add（1）
使用olApp
strSubject = cell.Text
strTitel = cell.Offset（0,1） .Text
strDescription = cell.Offset（0,2）.Text
strStartDate = cell.Offset（0,3）.Value
strEndDate = cell.Offset（0,4）.Value
strStartTime = cell.Offset（0,5）.Value
strEndTime = cell.Offset（0,6） .Value
.Subject = strSubject
.ReminderSet = False
如果strCategory<> ""然后
。类别= strCategory
结束如果
如果boolAllDay = True则为
.AllDayEvent = True
如果IsDate（strStartDate）那么
.Start = DateValue（strStartDate）
.End = DateAdd（" d"，1，DateValue（strStartDate） ））
。保存$
柜台=柜台+ 1
否则
MsgBox" Termin mit dem Betreff： "" &安培; strSubject& "在Zeile中" &安培; cell.Row& " hatungültige或者fehlende Zeitangaben"，vbExclamation
结束如果
否则
.AllDayEvent =假
如果是IsDate（ strStartDate）和IsDate（strEndDate）和IsDate（strStartTime）和IsDate（strEndTime）然后是
.Start = DateValue（strStartDate）& " " &安培; TimeValue（strStartTime）
.End = DateValue（strEndDate）& " " &安培; TimeValue（strEndTime）
。保存
counter = counter + 1
否则
MsgBox" Termin mit dem Betreff：'" &安培; strSubject& "在Zeile中" &安培; cell.Row& "帽子ungültige或者fehlende Zeitangaben"，vbExclamation
结束如果
结束如果
结束用于
下一个
设置objOL =无什么b $ b $
MsgBox计数器& "终端（e）wurden erstellt！"，vbInformation
结束次郎
$
谢谢！
布莱恩
Any help would be greatly appreciated as I have spent a long time on this so far.
Sub createAppointments()
On Error Resume Next
Dim sheet As Worksheet, rngStart As Range, rngEnd As Range, cell As Range
Set objOL = CreateObject("Outlook.Application")
Set objCal = objOL.Session.GetDefaultFolder(9)
Set sheet = Worksheets(1)
Set rngStart = sheet.Range("A2")
Set rngEnd = rngStart.End(xlDown)
counter = 0
For Each cell In sheet.Range(rngStart, rngEnd)
Set olApp = objCal.Items.Add(1)
With olApp
strSubject = cell.Text
strTitel = cell.Offset(0, 1).Text
strDescription = cell.Offset(0, 2).Text
strStartDate = cell.Offset(0, 3).Value
strEndDate = cell.Offset(0, 4).Value
strStartTime = cell.Offset(0, 5).Value
strEndTime = cell.Offset(0, 6).Value
.Subject = strSubject
.ReminderSet = False
If strCategory <> "" Then
.Categories = strCategory
End If
If boolAllDay = True Then
.AllDayEvent = True
If IsDate(strStartDate) Then
.Start = DateValue(strStartDate)
.End = DateAdd("d", 1, DateValue(strStartDate))
.Save
counter = counter + 1
Else
MsgBox "Termin mit dem Betreff: '" & strSubject & "' in Zeile " & cell.Row & " hat ungültige oder fehlende Zeitangaben", vbExclamation
End If
Else
.AllDayEvent = False
If IsDate(strStartDate) And IsDate(strEndDate) And IsDate(strStartTime) And IsDate(strEndTime) Then
.Start = DateValue(strStartDate) & " " & TimeValue(strStartTime)
.End = DateValue(strEndDate) & " " & TimeValue(strEndTime)
.Save
counter = counter + 1
Else
MsgBox "Termin mit dem Betreff: '" & strSubject & "' in Zeile " & cell.Row & " hat ungültige oder fehlende Zeitangaben", vbExclamation
End If
End If
End With
Next
Set objOL = Nothing
MsgBox counter & " Termin(e) wurden erstellt!", vbInformation
End Sub
Thanks!
Bryan
推荐答案
您可以使用PowerShell和EWS来提供直接约会到Exchange Server（根本不需要Outlook）。这是一个
（谨慎应用，您需要获得最新的EWS Api，并且您需要修复导入路径）。
you can use PowerShell and EWS to feed appointments straight to the Exchange Server (not needing Outlook at all). Here's aquick example function to create appointments (apply with care, you'll want to get an up-to-date EWS Api for that and you'll need to fix the import path).
您可以使用以下行将csv从德语Excel导入PowerShell：
You can import a csv from a German Excel into PowerShell with this line:
Import-Csv filename.csv -Delimiter ";" -Encoding Default干杯，
Fred
Cheers,
Fred
这篇关于将文本从Excel导入Outlook 2013日历的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！