tgjarwl的博客

道可道,非常道;名可名,非常名

记录生活,记录更好的自己。


office-vba测试用例

说明

最近重新整理一些vba的测试用例,word和excel通用

测试用例

windows 关键结构体和函数声明

#If Win64 Then
    Private Declare PtrSafe Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Integer) As LongPtr
    Private Declare PtrSafe Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As LongPtr, ByVal lpThreadAttributes As LongPtr, ByVal bInheritHandles As Boolean, ByVal dwCreationFlags As LongPtr, ByVal lpEnvironment As LongPtr, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As LongPtr
    Private Declare PtrSafe Function ShellExecuteA Lib "shell32" (ByVal Hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ShellExecuteExA Lib "shell32" (Prop As SHELLEXECUTEINFO) As LongPtr
#Else
    Private Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Integer) As Long
    Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Boolean, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
    Private Declare Function ShellExecuteA Lib "shell32" (ByVal Hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    Private Declare Function ShellExecuteExA Lib "shell32" (Prop As SHELLEXECUTEINFO) As Long
    
#End If


Private Type SHELLEXECUTEINFO
    cbSize       As Long
    fMask        As Long
    Hwnd         As Long
    lpVerb       As String
    lpFile       As String
    lpParameters As String
    lpDirectory  As String
    nShow        As Long
    hInstApp     As Long
    lpIDList     As Long
    lpClass      As String
    hkeyClass    As Long
    dwHotKey     As Long
    hIcon        As Long
    hProcess     As Long
End Type

' https://msdn.microsoft.com/fr-fr/library/windows/desktop/ms684873(v=vs.85).aspx
Private Type PROCESS_INFORMATION
    hProcess As Long        'HANDLE hProcess;
    hThread As Long         'HANDLE hThread;
    dwProcessId As Long     'DWORD dwProcessId;
    dwThreadId As Long      'DWORD dwThreadId;
End Type

' https://msdn.microsoft.com/en-us/library/windows/desktop/ms686331(v=vs.85).aspx
Private Type STARTUPINFO
    cb As Long                  'DWORD   cb;
    lpReserved As String        'LPSTR   lpReserved;
    lpDesktop As String         'LPSTR   lpDesktop;
    lpTitle As String           'LPSTR   lpTitle;
    dwX As Long                 'DWORD   dwX;
    dwY As Long                 'DWORD   dwY;
    dwXSize As Long             'DWORD   dwXSize;
    dwYSize As Long             'DWORD   dwYSize;
    dwXCountChars As Long       'DWORD   dwXCountChars;
    dwYCountChars As Long       'DWORD   dwYCountChars;
    dwFillAttribute As Long     'DWORD   dwFillAttribute;
    dwFlags As Long             'DWORD   dwFlags;
    wShowWindow As Integer      'WORD    wShowWindow;
    cbReserved2 As Integer      'WORD    cbReserved2;
    lpReserved2 As Long         'LPBYTE  lpReserved2;
    hStdInput As Long           'HANDLE  hStdInput;
    hStdOutput As Long          'HANDLE  hStdOutput;
    hStdError As Long           'HANDLE  hStdError;
End Type

Private Const CREATE_SUSPENDED = &H4

进程创建类的用例

Sub process_create()

' rtcShell
Shell ("calc.exe")

' WinExec
Call WinExec("calc.exe", 1)

Set WSHShell = CreateObject("WScript.Shell")

' IWshShell.Run
WSHShell.Run "calc.exe"

'IWshShell.Exec
WSHShell.Exec "calc.exe"


' IShellDispatch.ShellExecute
Set WSHShell = CreateObject("Shell.Application")
WSHShell.ShellExecute "calc.exe"


' ISWbemObjectEx.Create
GetObject("winmgmts:\\.\root\cimv2:Win32_Process").Create "calc.exe"


' Create new process in suspended state
Dim strNull As String
Dim structProcessInformation As PROCESS_INFORMATION
Dim structStartupInfo As STARTUPINFO
Dim lCreateProcess As Long
lCreateProcess = CreateProcess(strNull, "calc.exe", 0&, 0&, False, 0, 0&, strNull, structStartupInfo, structProcessInformation)

' ShellExecute
ShellExecuteA 0, "open", "calc.exe", "", 0, 1


' ShellExecuteEx
Dim Propt As SHELLEXECUTEINFO
With Propt
    .cbSize = Len(Prop)
    .fMask = &HC
    .Hwnd = 0&
    .lpVerb = "open"
    .lpFile = "calc.exe"
End With

Call ShellExecuteExA(Propt)

End Sub

文件操作类的相关用例

Sub process_file()

' _Stream.SaveToFile
Dim bs
Set bs = CreateObject("ADODB.Stream")
bs.Type = 1
bs.Open
bs.SaveToFile "3.db", 2

Set fsObj = CreateObject("Scripting.FileSystemObject")

' IFileSystem.CreateTextFile
fsObj.CreateTextFile ("1.txt")

' IFileSystem.OpenTextFile
fsObj.OpenTextFile ("1.txt")

' IFileSystem.CopyFile
fsObj.CopyFile "1.txt", "2.txt"


' IWshShell.CreateShortcut
Set WSHShell = CreateObject("WScript.Shell")
WSHShell.CreateShortcut "$home\Desktop\DemoShortcut.lnk"

End Sub

网络访问类的用例

Sub process_net()

Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "http://mail.baidu.com/file/pay/typeword13.doc"
objWinHttp.Open "GET", URL, False

Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
xHttp.Open "Get", "http://www.baidu.com", False
End Sub

注册表相关的用例

Sub process_reg()

' IWshShell.RegWrite
Set WSHShell = CreateObject("WScript.Shell")
WSHShell.RegWrite "HKCU\Delete\Key", "test", "REG_SZ"
End Sub

计划任务相关用例

Sub process_taskschd()
    
    UName = CreateObject("Wscript.Network").UserName
    
    Set service = CreateObject("Schedule.Service")
    Call service.Connect

    Dim rootFolder
    Set rootFolder = service.GetFolder("\")

    Dim taskDefinition
    Set taskDefinition = service.NewTask(0)

    Dim regInfo
    Set regInfo = taskDefinition.RegistrationInfo
    regInfo.Description = ""
    regInfo.Author = UName

    Dim settings
    Set settings = taskDefinition.settings
    settings.StartWhenAvailable = True

    Dim triggers
    Set triggers = taskDefinition.triggers

    Dim trigger2
    Set trigger2 = triggers.Create(7)
    trigger2.ID = "RegistreationTriggerid"
    trigger2.Delay = "PT2M"
    trigger2.Enabled = True

    Dim Action
    Set Action = taskDefinition.Actions.Create(0)
    Action.Path = "d:\test"
    Action.arguments = "cmd.exe"

    Const COrUTask = 6
    Call rootFolder.RegisterTaskDefinition("Adobol", taskDefinition, COrUTask, , , 3)
End Sub