トップ > VBA

VBA取得に役立つサイト一覧

VBA

Office TANAKA - Excel VBA関数[目次]
Microsoft.VisualBasic 名前空間
VBAのヘルプで、このページは利用できません。と表示される :Office 2010(オフィス2010)の使い方
☆ Excelでお仕事！(Excel全般の解説サイト) ☆
テストエビデンス取得自動化の秘技（前編）：Selenium VBAを使って自動でブラウザーを操作してスクショをExcelに張り付けてみた (1/4) - ＠IT

VBAパスワード解除

VBA
  1. VBAパスワードロックされたExcelファイルを開く。
  2. 次にxlsmファイルを新規作成する。
  3. xlsmファイルのVBAを開く。
  4. 標準モジュールにModule1を作成し以下のコードをコピペする。
Option Explicit

Private Const PAGE_EXECUTE_READWRITE = &H40

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Long, Source As Long, ByVal Length As Long)

Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, _
ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long

Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
ByVal lpProcName As String) As Long

Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As Long, _
ByVal pTemplateName As Long, ByVal hWndParent As Long, _
ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer

Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As Long
Dim Flag As Boolean

Private Function GetPtr(ByVal Value As Long) As Long
GetPtr = Value
End Function

Public Sub RecoverBytes()
If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub

Public Function Hook() As Boolean
Dim TmpBytes(0 To 5) As Byte
Dim p As Long
Dim OriginProtect As Long

Hook = False

pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")


If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then

MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
If TmpBytes(0) <> &H68 Then

MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6

p = GetPtr(AddressOf MyDialogBoxParam)

HookBytes(0) = &H68
MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
HookBytes(5) = &HC3

MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
Flag = True
Hook = True
End If
End If
End Function

Private Function MyDialogBoxParam(ByVal hInstance As Long, _
ByVal pTemplateName As Long, ByVal hWndParent As Long, _
ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
If pTemplateName = 4070 Then
MyDialogBoxParam = 1
Else
RecoverBytes
MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
hWndParent, lpDialogFunc, dwInitParam)
Hook
End If
End Function
  1. 同様にModule2を作成し、以下をコピペする。
Sub unprotected()
If Hook Then
MsgBox "VBA Project is unprotected!", vbInformation, "*****"
End If
End Sub
  1. unprotectedを実行。

メールドリブン outlookマクロ

VBA 
Option Explicit

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim itm As Object
Dim msg As String
Dim IE As Object

Set itm = Application.Session.GetItemFromID(EntryIDCollection)
If LCase(TypeName(itm)) = "mailitem" Then
With itm.ReplyAll
    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Navigate "http://lifework.hatenablog.com/category/VBA"
        .Visible = True
    End With
    Set IE = Nothing

End With
End If
End Sub

vba

VBA

Option Explicit
Sub a()
''http://blog.livedoor.jp/akf0/archives/51597085.html
''どこかのPCでExcelを開いておいてタイマー起動しておく。

Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")

ie.Visible = True
ie.Navigate ("http://www.google.co.jp/")

' ダウンロード待ち
Do While ie.Busy
Loop

' 結果出力
''Debug.Print ie.Document.Body.InnerHTML


Dim FileNumber As Integer
Dim Path As String

'使用されていないファイル番号を取得する
FileNumber = FreeFile
Path = "C:\eclipse\test.html"

'ファイルを開く
Open Path For Output As #FileNumber

'データを出力する
'' Print #FileNumber, "あいうえお";
Print #FileNumber, "取得日取得時";
Print #FileNumber, ie.Document.Body.InnerHTML;

'ファイルを閉じる
Close #FileNumber

Set ie = Nothing
End Sub