IT Knowledge Base

01. 同事想要向參加者發出一份出席證書，證書格式已存在Powerpoint，而手上亦有一份參加者名單，存放在Excel表格中。

02. 同事第一個要求很簡單，是如何將Excel中參加者的姓名，放入到Powerpoint中，再存為PDF檔案，以便之後用Outlook發到參加者電郵。

03. 打開Powerpoint檔案，按鍵盤『ALT + F10』，將要更改內容的Shape設定名稱，以便之後VBA可以用此名稱，更改內裡內容。

04. 很快從網上抄抄改改，就完成以下的程式碼。先預設一個1000個X2陣列，以便儲存從Excel輸入的使用者姓名及電郵數據。打開Excel檔案(VBA限制一定要用絕對路徑(absolute path)，所以就將Powerpoint及Excel檔案放到c:\temp資料夾內)，之後用『ActivePresentation.Slides(1).Shapes(“username”)』更改內容，最後儲存PDF檔案到相同資料夾位置。

Sub ImportFromExcel()
Dim xlApp As Object
Dim xlWorkBook As Object
Dim user(1000, 2) As String
Set xlApp = CreateObject("Excel.Application")
Set xlWorkBook = xlApp.Workbooks.Open("c:\temp\report.csv", True, False)
i = 7
While (xlWorkBook.sheets("report").Cells(i, 1)) <> ""
i = i + 1
Wend
k = 1
For j = 7 To i - 1
user(k, 1) = xlWorkBook.sheets("report").Cells(j, 1) + " " + xlWorkBook.sheets("report").Cells(j, 2)
user(k, 2) = xlWorkBook.sheets("report").Cells(j, 3)
k = k + 1
Next j
For l = 1 To k - 1
ActivePresentation.Slides(1).Shapes("username").TextFrame.TextRange.Characters.Text = user(l, 1) + " is awarded to"
file = "c:\temp\" + user(l, 2) + ".pdf"
With Application.ActivePresentation
.SaveAs file, ppSaveAsPDF
End With
Next l
Set xlApp = Nothing
End Sub

05. 很快，大家也發現問題。PDF檔案是有了，那是不是要同事一個個在Outlook開新電郵，再附上參加者PDF證書，再加上標題、電郵及內容，再發送電郵呢？那可是接近250個參加者事情呢！

06. 既然Powerpoint VBA可以連到Excel，那是不是代表一樣可以連到Outlook，就成為下一個午餐有無著落的事情。

07. 繼續從網上抄抄改改，不到半天就完成以下成品。和之前分別不大，只是加入輸出到新電郵程式碼，以及因為電郵要用到名字的關係，所以陣列改為1000個X3，最後一個就是用來儲存參加者名字，附上PDF檔案，加入標題、內容，最後儲存到Outlook草稿資料夾內，由同事決定幾時發出電郵。

Sub SaveOutlookCertificate()
Dim xlApp As Object
Dim xlWorkBook As Object
Dim OlApp As Object
Dim olMsg As Object
Dim user(1000, 3) As String
Set xlApp = CreateObject("Excel.Application")
Set OlApp = CreateObject("Outlook.Application")
Set xlWorkBook = xlApp.Workbooks.Open("c:\temp\report.csv", True, False)
i = 7
While (xlWorkBook.sheets("report").Cells(i, 1)) <> ""
i = i + 1
Wend
k = 1
For j = 7 To i - 1
user(k, 1) = xlWorkBook.sheets("report").Cells(j, 1) + " " + xlWorkBook.sheets("report").Cells(j, 2)
user(k, 2) = xlWorkBook.sheets("report").Cells(j, 3)
user(k, 3) = xlWorkBook.sheets("report").Cells(j, 1)
k = k + 1
Next j
For l = 1 To k - 1
ActivePresentation.Slides(1).Shapes("username").TextFrame.TextRange.Characters.Text = user(l, 1) + " is awarded to"
file = "c:\temp\" + user(l, 2) + ".pdf"
With Application.ActivePresentation
.SaveAs file, ppSaveAsPDF
End With
Set olMsg = OlApp.CreateItem(0)
With olMsg
.Subject = "Certificate of xxxxxx 2021"
.HTMLBody = "Dear " & user(l, 3) & "

This is your certificate"
.Attachments.Add file
.To = user(l, 2)
End With
olMsg.Save
Next l
Set xlApp = Nothing
Set OlApp = Nothing
End Sub

08. 最後電郵結果。