一旦在摘要中有像访问父母这样的中文字符，宏就会停止。 使用英语很好。 使用中文显示运行时错误'5'：无效的过程调用或参数，当进入细节时，下面的行突出显示。 objFile.write“SUMMARY：”＆amp;摘要＆amp; vbCrLf 如何解决这个问题的帮助将不胜感激。
Sub Create_ICS()
Dim CSV_Name As String
CSV_Name = ThisWorkbook.Names("CSV_Name").RefersToRange + ".ics"
If CSV_Name = ".ics" Then GoTo No_Filename
Dim Folder_Existence As String
Folder_Existence = ThisWorkbook.Names("Folder_Existence").RefersToRange
If Folder_Existence <> "" Then GoTo No_Such_Folder
Sheets("ICS").Select
' PARAMETERS
Dim Last_Columm As Long
Last_Columm = 21
Dim First_Row As Long
First_Row = 2
Dim ICS_Format As String
ICS_Format = ThisWorkbook.Names("ICS_Format").RefersToRange
Dim Time_Zone_Selected As String
Time_Zone_Selected = ThisWorkbook.Names("Time_Zone_Selected").RefersToRange
Dim Calendar_ID As String
Calendar_ID = ThisWorkbook.Names("Calendar_ID").RefersToRange
Dim CSV_Directory As String
CSV_Directory = ThisWorkbook.Names("CSV_Directory").RefersToRange
Dim Sync_URL As String
Sync_URL = ThisWorkbook.Names("Sync_URL").RefersToRange + CSV_Name
Dim Time_Format As String
Time_Format = ThisWorkbook.Names("Time_Format").RefersToRange
If Time_Format = "Excel Timestamps" Then Application.Run "Excel_Timestamps"
Dim Total_Errors As Long
Application.Calculate
Total_Errors = ThisWorkbook.Names("Total_Errors").RefersToRange
If Total_Errors > 0 Then GoTo Fix_Errors
Start_Export:
Dim CSV_Slash As String
CSV_Slash = Right(CSV_Directory, 1)
Dim Slash As String
If CSV_Slash = "\" Then Slash = ""
If CSV_Slash <> "\" Then Slash = "\"
Dim CSV_Filename As String
CSV_Filename = CSV_Directory + Slash + CSV_Name
Dim rng1 As Range, X, i As Long, v As Long
Dim objFSO, objFile
Dim FilePath As String
FilePath = "D:\test.ics"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(CSV_Filename)
' SET AREA
Set rng1 = Range(Cells(First_Row, 1), Cells(Cells(Rows.Count, "A").End(xlUp).Row, Last_Columm))
X = rng1
'GoTo Details
' CREATE HEADER
objFile.write "BEGIN:VCALENDAR" & vbCrLf
objFile.write "CALSCALE:GREGORIAN" & vbCrLf
objFile.write "VERSION:2.0" & vbCrLf
objFile.write "METHOD:Publish" & vbCrLf
objFile.write "PRODID:-//None" & vbCrLf
Details:
Dim Summary As String
Dim Description As String
Dim DateStart As String
Dim TimeStart As String
Dim DateEnd As String
Dim TimeEnd As String
Dim Location As String
Dim Frequency As String
Dim Interval As String
Dim When As String
Dim ByDay As String
Dim ByMonthDay As String
Dim ByYearDay As String
Dim ByWeekNo As String
Dim ByMonth As String
Dim BySetPos As String
Dim WkSt As String
Dim Color As String
Dim Alarm As String
Dim TzId As String
Dim UID As String
' Create Details
For i = 1 To UBound(X, 1)
Summary = X(i, 1)
Description = X(i, 2)
DateStart = X(i, 3)
TimeStart = X(i, 4)
DateEnd = X(i, 5)
TimeEnd = X(i, 6)
Location = X(i, 7)
Frequency = X(i, 8)
Interval = X(i, 9)
When = X(i, 10)
ByDay = X(i, 11)
ByMonthDay = X(i, 12)
ByYearDay = X(i, 13)
ByWeekNo = X(i, 14)
ByMonth = X(i, 15)
BySetPos = X(i, 16)
WkSt = X(i, 17)
Color = X(i, 18)
Alarm = X(i, 19)
TzId = X(i, 20)
UID = X(i, 21)
'11
ByMonthDay = Right(DateStart, 2) / 1
If BySetPos = "L" Then BySetPos = "-1"
'14
ByMonth = Mid(DateStart, 5, 2) / 1
objFile.write "BEGIN:VEVENT" & vbCrLf
objFile.write "UID:" & UID & vbCrLf
objFile.write "DTSTAMP" & TzId & ":" & DateStart & "T000000" & ICS_Format & vbCrLf
If Description <> "" Then
objFile.write "DESCRIPTION:" & Description & vbCrLf
End If
If TimeStart = "" Or TimeStart = "0" And TimeEnd = "0" Then
objFile.write "DTEND;VALUE=DATE:" & DateEnd & vbCrLf
Else
If Len(TimeEnd) = 3 Then TimeEnd = "000" + TimeEnd
If Len(TimeEnd) = 4 Then TimeEnd = "00" + TimeEnd
If Len(TimeEnd) = 5 Then TimeEnd = "0" + TimeEnd
objFile.write "DTEND" & TzId & ":" & DateEnd & "T" & TimeEnd & vbCrLf
End If
If Location <> "" Then
objFile.write "LOCATION:" & Location & vbCrLf
End If
objFile.write "SUMMARY:" & Summary & vbCrLf
If TimeStart = "" Or TimeStart = "0" And TimeEnd = "0" Then
objFile.write "DTSTART;VALUE=DATE:" & DateStart & vbCrLf ' All Day
Else
If Len(TimeStart) = 3 Then TimeStart = "000" + TimeStart
If Len(TimeStart) = 4 Then TimeStart = "00" + TimeStart
If Len(TimeStart) = 5 Then TimeStart = "0" + TimeStart
objFile.write "DTSTART" & TzId & ":" & DateStart & "T" & TimeStart & vbCrLf
End If
If TimeStart = "" Or TimeStart = "0" And TimeEnd = "0" Then
objFile.write "X-MICROSOFT-CDO-ALLDAYEVENT:TRUE" & vbCrLf
objFile.write "X-FUNAMBOL-ALLDAY:1" & vbCrLf
End If
If Frequency <> "" And Interval = "" Then Interval = "1"
If Frequency = "DAILY" Then
objFile.write "RRULE:FREQ=DAILY" & vbCrLf
ElseIf Frequency = "WEEKLY" Then
objFile.write "RRULE:FREQ=" & Frequency & ";INTERVAL=" & Interval & vbCrLf
' Day X of each Y months
ElseIf Frequency = "MONTHLY" And ByDay = "" Then
objFile.write "RRULE:FREQ=MONTHLY;INTERVAL=" & Interval & "BYMONTHDAY=" & ByMonthDay & vbCrLf
' Xth WeekDay of each Y months
ElseIf Frequency = "MONTHLY" And ByDay <> "" Then
objFile.write "RRULE:FREQ=MONTHLY;INTERVAL=" & 1 & ";BYDAY=" & When & ByDay & vbCrLf
ElseIf Frequency = "YEARLY" And ByYearDay <> "" Then
objFile.write "RRULE:FREQ=YEARLY;INTERVAL=" & Interval & ";BYYEARDAY=" & ByYearDay & vbCrLf
ElseIf Frequency = "YEARLY" And ByYearDay = "" Then
objFile.write "RRULE:FREQ=YEARLY;INTERVAL=" & Interval & ";BYMONTHDAY=" & ByMonthDay & ";BYMONTH=" & ByMonth & vbCrLf
End If
If Alarm <> "" Then
Dim TRIGGER As String
If Alarm = "0" Then TRIGGER = "+PT0S"
If Alarm = "1440" Then TRIGGER = "-P1DT0S"
If Alarm / 1 > 0 And Alarm / 1 < 60 Then TRIGGER = "-PT0H" & Alarm & "M0S"
If Alarm / 1 > 59 And Alarm / 1 < 1440 Then TRIGGER = "-PT" & Int(Alarm / 60) & "H" & (Alarm / 60 - Int(Alarm / 60)) * 60 & "M0S"
objFile.write "DESCRIPTION:Event Reminder" & vbCrLf
objFile.write "ACTION: DISPLAY" & vbCrLf
objFile.write "End:VALARM" & vbCrLf
End If
If Color <> "" Then
objFile.write "X-UTILITAP-COLOR: " & Color & vbCrLf
End If
objFile.write "END:VEVENT" & vbCrLf
Skip_Record:
Next i
' Create Footer
objFile.write "END:VCALENDAR"
Sheets("Instructions").Select
MsgBox "File " + CSV_Directory + CSV_Name + " created..."
GoTo Finish
Close_CSV:
MsgBox " The destination file " + CSV_Name + " is open, please close it first..."
GoTo Finish
No_Such_Folder:
MsgBox "Folder '" + CSV_Directory + "' doesn't exist, please fix this first...."
Application.GoTo Reference:="CSV_Directory"
GoTo Finish
No_Filename:
MsgBox "No file name specified, please fix this first...."
Application.GoTo Reference:="CSV_Name"
GoTo Finish
No_ICS_Rows:
MsgBox "Sheet 'ICS' doesn't contain calendar items, nothing to export...."
GoTo Finish
Fix_Errors:
MsgBox "Sheet 'ICS' contains errors, please fix these first...."
Application.Run "Filter_Errors"
GoTo Finish
No_Error_Checks:
MsgBox "Sheet ICS doesn't contain error checks, this will be fixed now...."
Application.Run "Calendar_Checks"
Application.Calculate
GoTo Finish
Finish:
End Sub
答案 0 :(得分：1)
错误在于：
Set objFile = objFSO.CreateTextFile(CSV_Filename)
默认情况下，创建为Ascii而不是UniCode。替换为
Set objFile = objFSO.CreateTextFile(filename:=CSV_Filename, Unicode:=true)