1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
|
Sub ImportICS()
Dim filename As String
filename = Application.GetOpenFilename("Calendar Files (*.ics),*.ics")
If filename = "False" Then Exit Sub
Dim fso As Object, ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(filename, 1)
Dim line As String, r As Long, dtStr As String, dtArr() As String
line = ts.ReadLine
r = 1
Do Until ts.AtEndOfStream
Select Case True
Case Left(line, 2) = "DT"
Cells(r, "A") = Split(line, ":")(0)
dtStr = Replace(line, Cells(r, "A") & ":", "")
dtArr = Split(Replace(dtStr, "Z", ""), "T")
Cells(r, "B") = DateSerial(Left(dtArr(0), 4), Mid(dtArr(0), 5, 2), Right(dtArr(0), 2)) _
+ TimeSerial(Left(dtArr(1), 2), Mid(dtArr(1), 3, 2), Right(dtArr(1), 2))
Case Left(line, 7) = "CREATED"
Cells(r, "A") = Split(line, ":")(0)
dtStr = Replace(line, Cells(r, "A") & ":", "")
dtArr = Split(Replace(dtStr, "Z", ""), "T")
Cells(r, "B") = DateSerial(Left(dtArr(0), 4), Mid(dtArr(0), 5, 2), Right(dtArr(0), 2)) _
+ TimeSerial(Left(dtArr(1), 2), Mid(dtArr(1), 3, 2), Right(dtArr(1), 2))
Case Left(line, 13) = "LAST-MODIFIED"
Cells(r, "A") = Split(line, ":")(0)
dtStr = Replace(line, Cells(r, "A") & ":", "")
dtArr = Split(Replace(dtStr, "Z", ""), "T")
Cells(r, "B") = DateSerial(Left(dtArr(0), 4), Mid(dtArr(0), 5, 2), Right(dtArr(0), 2)) _
+ TimeSerial(Left(dtArr(1), 2), Mid(dtArr(1), 3, 2), Right(dtArr(1), 2))
Case Else
Cells(r, "A") = Split(line, ":")(0)
Cells(r, "B") = Replace(line, Cells(r, "A") & ":", "")
End Select
line = ts.ReadLine
r = r + 1
Loop
End Sub
|