Outlook VBA 取得並建立相同的資料夾結構

以下VBA程式為在Outlook下取得並建立相同的資料夾結構

Sub MailFolder()
Dim myNameSpce As Outlook.NameSpace
Dim mySourFolder, myDestFolder As Outlook.MAPIFolder
Dim subFolder, thisFolder, thismyDestFolder As Outlook.MAPIFolder
Dim uName As String

uName = VBA.Environ("UserName") '取得登入名稱

Set myNameSpace = Application.GetNamespace("MAPI")
Set mySourFolder = myNameSpace.Folders(uName + "_2013").Folders("收件匣") '來源資料檔"收件匣"物件
Set myDestFolder = myNameSpace.Folders(uName + "_2014").Folders("收件匣") '目標資料檔"收件匣"物件

For i = 1 To mySourFolder.Folders.Count
    Set thisFolder = mySourFolder.Folders(i)
    On Error Resume Next '發生錯誤也繼續執行，避免資料夾已存在
    myDestFolder.Folders.Add (thisFolder.Name)  '於目標資料檔下建立資料夾
    Set thismyDestFolder = myDestFolder.Folders(thisFolder.Name)
 
    If thisFolder.Folders.Count <> 0 Then '判斷 "收件匣" 下的 "子資料夾" 下是否還有子資料夾
        Set subFolder = subFolders(thisFolder, thismyDestFolder)
    End If
Next i
 
End Sub

Function subFolders(ByVal mySourFolder As Outlook.MAPIFolder, myDestFolder As Outlook.MAPIFolder) As Outlook.MAPIFolder
Dim subFolder, thisFolder, thismyDestFolder As Outlook.MAPIFolder

For i = 1 To mySourFolder.Folders.Count
    Set thisFolder = mySourFolder.Folders(i)
    On Error Resume Next '發生錯誤也繼續執行，避免資料夾已存在
    myDestFolder.Folders.Add (thisFolder.Name)  '於目標資料檔下建立資料夾
    Set thismyDestFolder = myDestFolder.Folders(thisFolder.Name)
 
    If thisFolder.Folders.Count <> 0 Then '判斷 "收件匣" 下的 "子資料夾" 下是否還有子資料夾
        Set subFolder = subFolders(thisFolder, thismyDestFolder)
    End If
Next i

End Function

使用VB Script安裝網路印表機驅動

將以下文字存成*.VBS的檔案，再修改相關參數即可
(連接埠IP、INF路徑、驅動程式模組與名稱)

 '本例以HP1022N做示範
Set objWMIService = GetObject("winmgmts:")
Set objNewPort = objWMIService.Get _
("Win32_TCPIPPrinterPort").SpawnInstance_

'設定連接埠IP
objNewPort.HostAddress = "192.168.61.101"    '網路印表機IP
objNewPort.Name = "IP_192.168.61.101"        '印表機連接埠名稱

'設定連接埠Protocol
objNewPort.Protocol = 1                '1: RAW   2:LPR
objNewPort.PortNumber = "9100"            '印表機連接埠號 RAW=9100,LPR=515
objNewPort.Queue="LPR" 'LPR
objNewPort.ByteCount="TRUE"            '啟用LPR位元組計數

'設定是否使用SNMP
objNewPort.SNMPEnabled = False            '是否使用SNMP
objNewPort.Put_

'設定印表機驅動路徑與名稱
PrinterDriver_inf= ".\HP1022N\HPLJ1020.inf"    '驅動程式inf檔案位置
Printer_Model = "HP LaserJet 1022n"        '驅動程式模組
Printer_Name = "HP LaserJet 1022n"        '印表機名稱

'開始安裝(以下不可變更)
sCmd = "rundll32.exe printui.dll,PrintUIEntry /if /b """ &Printer_Name& """ /f """ _
& PrinterDriver_inf &""" /r" _
& " """ &objNewPort.Name& """ /m """&Printer_Model&""

cmd = "control printers"
DefaultPrint = "rundll32 printui.dll,PrintUIEntry /y /n """ &Printer_Name&""

Set oShell = CreateObject("WScript.Shell")
oShell.Run sCmd, 1, True
oShell.Run cmd
oShell.Run DefaultPrint

WScript.Echo Printer_Name&" 安裝完成!"