請各位VBA大神救命！？

01-28

我們公司最近進行文件安全檢查（涉及公司就不提公司名稱了），領導一聽涉及安全就胡亂點將讓我負責（我是部門的安全人員），去了我才知道我真搞不定，原來文件安全管理是這樣的：在所有文檔的左上角插入兩個文本框，一個標註文件等級，如機密、絕密。一個標註文件存檔日期。具體如下圖：
我想哭死的心都有，全部門幾百台電腦，每個電腦上千個文檔，涉及word文檔，excel文檔，powerpoint文檔。全部需要添加，這簡直讓我哭暈在電腦旁。後來經人點播說有一利器可解此圍，名曰VBA，怎奈小弟學安全專業出身，編程一竅不通，特情各位大神解此危難。拜謝！

求教如何能快速的將一台電腦上所有的文檔，包括word文檔，excel文檔，powerpoint文檔的左上角直接添加上兩個文本框（其中等級日期無所謂，檢查時有就行）？再次拜謝！

有幾點再補充一下：

(1) 剛注意到樓主說的是要添加兩個文本框。其實很簡單，原答案中每一段 set tbox 到 tbox.textframe 都是添加一個文本框並設定其格式和內容。所以只要把這樣的每一段都再複製一遍，把參數改成第二個文本框的設置就行了。

(2) 如果樓主需要遍歷整個電腦的所有文件夾包括子文件夾，在VBA中一般需要使用FSO配合遞歸或多棧的演算法來實現。如果有此必要，可以到網上找一個VBA遍歷全部文件夾的例子代碼，然後把原答案中 Do While 和 fName=Dir 這個循環體內的內容放到遍歷全部文件夾的那個循環體內。不過這樣做一方面還是要求樓主具備基本的VBA知識和調試能力，另一方面，貿然對全電腦所有文件做修改操作，風險非常大，一旦有差錯甚至很可能無法察覺和恢復。所以還是建議樓主多費些人工，在複製出來的文件上做操作，然後確認沒有問題後，再替換原文件。畢竟在公司里，提高效率不算功勞、但搞丟數據絕對算是大錯。

==================以下是原答案============================

首先，這個問題可以用VBA解決，可以參考下面這個代碼的思路（代碼是我剛剛寫的，時間關係只是實現了大體的功能，沒有充分考慮所有可能出現的異常情況，沒有時間做詳細的測試，也沒有加入對出現異常時進行日誌記錄的功能）。

說明：你可以把這個代碼複製到Excel或Word或PPT的VBA編輯器中（寫在標準模塊裡面）。同時為了簡化問題，這裡假設你事先把所有需要打水印的word/ppt/excel文件都拷貝到了同一個文件夾下。

Option Explicit


Sub insertTextBoxes()
    Dim tbox As Object, file As Object, appWord As Object, appExl As Object, appPPT As Object

    Dim fName As String, fPath As String, fExt As String
    Set appWord = CreateObject("word.application")

    Set appExl = CreateObject("excel.application")

    Set appPPT = CreateObject("powerpoint.application")
    將待處理文件放置於同一個目錄下，將絕對路徑寫入fPath變數。

    fPath = "d:vbademoa"
    fName = Dir(fPath)
    Do While fName &<&> ""
        If InStr(fName, ".") &> 0 Then
            fExt = Left(LCase(Mid(fName, InStrRev(fName, ".") + 1)), 3)
            如果擴展名前三位是doc，則按word處理，可酌情修改word文本框各種格式參數。

            If fExt = "doc" Then
                Set file = appWord.documents.Open(fPath  fName)
                添加文本框，後四個參數為該文本框的left/top/width/height，

                excel與ppt中該方法的參數含義相同。

                Set tbox = file.Shapes.AddTextbox(1, 50, 120, 100, 50)

                With tbox.Line

                    .ForeColor.RGB = RGB(255, 0, 0)

                    .Weight = 2

                End With

                tbox.TextFrame.TextRange.Text = "2017/9/2"  Chr$(10)  "Checked"
                file.Save

                file.Close
            如果擴展名前三位是xls，則按excel處理，可酌情修改excel文本框各種格式參數

            ElseIf fExt = "xls" Then
                Set file = appExl.Workbooks.Open(fPath  fName)
                Set tbox = file.Worksheets(1).Shapes.AddTextbox(1, 50, 120, 100, 50)

                With tbox.Line

                    .ForeColor.RGB = RGB(255, 0, 0)

                    .Weight = 2

                End With
                tbox.TextFrame2.TextRange.Characters.Text = "2017/9/2"  Chr$(10)  "Checked"
                file.Save

                file.Close
            如果擴展名前三位是ppt，則按powerpoint處理，可酌情修改ppt文本框各種格式參數

            ElseIf fExt = "ppt" Then
                Set file = appPPT.presentations.Open(fPath  fName)
                PPT中允許沒有幻燈片，所以需要特別判斷

                If file.slides.Count &> 0 Then

                    Set tbox = file.slides(1).Shapes.AddTextbox(1, 50, 120, 100, 50)

                    With tbox.Line

                        .Weight = 2

                        .ForeColor.RGB = RGB(255, 0, 0)

                    End With
                    tbox.TextFrame.TextRange.Characters.Text = "2017/9/2"  Chr$(10)  "Checked"

                End If
                file.Save

                file.Close
            End If
        End If
        Set file = Nothing
        fName = Dir
    Loop
    Set appWord = Nothing

    Set appExl = Nothing

    Set appPPT = Nothing

End Sub

但我想說的是，由於你的實際需求可能會非常複雜（比如可能會遇到各種不同版本的office文件、可能會出現設置為「只讀」的文件、文件名中可能會出現特殊字元、可能會有已經損壞的office文件、可能你的windows系統設置或office軟體設置比較特殊 …… ），所以除非你自己對VBA程序設計有一定的了解、能夠在遇到問題時自己調試修改代碼，否則很難保證上面這段程序能夠一次成功。你可以考慮把要打水印的文件分批放入文件夾中用這個代碼處理，這樣在出問題時範圍比較可控，也便於檢驗和Rollback。

最後，還是建議你有時間自己學習一下VBA

開啟宏，給設個方便的快捷鍵，正常操作一次，關閉宏的記錄。

打開文件，按一下快捷鍵

無需任何vba知識。如果周邊有會vba的，設個自動打開，自動執行，再自動關閉的循環就更方便了。

安全，不是備份，防火牆，殺毒之類的嗎？要不你寫個載入宏試試看，一打開office文件就自動載入你要的文本框