手っ取り早く作れる説明を別途準備しました｡

実用プログラム:ZIP解凍

説明:
BASE_PATHが解凍先フォルダとなります。
事前にindex_ZIP.txtファイルに格納されたZIPファイルリストを
ex) index_ZIP.txt
d:\abc.zip
d:\def.zip
順番に読込ながら、解凍したファイルをBASE_PATH内に保管します。

Sub extract_zip()
    Dim zipFile As Variant, strMove As String
    Dim unzipFolder As Variant
    Dim sh As Object
    Dim REC As String, BASE_PATH as String

    BASE_PATH="d:\"

    Open "index_ZIP.txt" For Input As #1

    Do While Not EOF(1)

        Line Input #1, REC
        zipFile = REC 'zipファイル
        unzipFolder = BASE_PATH '解凍フォルダ

        Set sh = CreateObject("Shell.Application")
        sh.NameSpace(unzipFolder).CopyHere sh.NameSpace(zipFile).Items
        DoEvents

        '解凍済ZIPの退避
        strMove = Replace(zipFile, "Attachment", "Attachment\done")
        Name zipFile As strMove
    Loop

    Close

    MsgBox "done!"
End Sub

'初期化したいとき
Application.MacroOptions Macro:="kansu", ShortcutKey:=""

'下記はCTRL+aとなる
Application.MacroOptions Macro:="kansu", ShortcutKey:="a"
'CTRL+SHIFTにしたいときは、aを大文字Aにする

Sub set_graph_lob_fam()
	ActiveChart.Axes(xlValue).Select
	ActiveChart.Axes(xlValue).MinimumScale = 0
	ActiveChart.Axes(xlValue).MaximumScale = 0.01
	ActiveChart.Axes(xlValue).MajorUnit = 0.002
End Sub

Sub All_IE_Close()

	Dim ObjIE As Object
	Dim ObjShell As Object
	Dim ObjWindow As Object

	Set ObjShell = CreateObject("Shell.Application")
	'全shellをチェックしてIEならClose
	For Each ObjWindow In ObjShell.Windows
		If TypeName(ObjWindow.Document) = "HTMLDocument" Then ObjWindow.Quit
	Next

	'1だけメインのIEを起動する
	Set ObjIE = CreateObject("InternetExplorer.application")
	ObjIE.Visible = True
	ObjIE.Navigate "http://xxxxxxxxxx"

End Sub

Sub Go()

	Dim ObjIE As Object
	Dim ObjShell As Object
	Dim ObjWindow As Object
	Dim wkTEXT As String, intISR As Integer
	Dim txtISR As String, intEnd As Integer, Y As Integer

	Set ObjShell = CreateObject("Shell.Application")
	'全shellをチェック
	For Each ObjWindow In ObjShell.Windows
		'IEならば
		If TypeName(ObjWindow.Document) = "HTMLDocument" Then
			Set ObjIE = ObjWindow
			'フィールドに値をセット＆クリック＆3秒待ち
			ObjIE.Document.forms(1).Item("xxxx").Value = "xxx"
			ObjIE.Document.all("xxxxx").click
			Application.Wait Time:=Now + TimeValue("00:00:03")
			'結果HTMLから必要な文字列の取り出し
			wkTEXT = ObjIE.Document.body.innerText
			intISR = InStr(1, wkTEXT, "ISR ")
			intEnd = InStr(1, wkTEXT, "xxxx")
			'値が見つかれば
			If intISR > 0 Then
				txtISR = Trim(Mid(wkTEXT, intISR + 4, intEnd – intISR – 6))
				Debug.Print txtISR
			End If
			'強制終了
			MsgBox "Done!"
			End
		End If
	Next

End Sub

Function Xlookup(CUST_NAME As String, GetColumn As String)

	Dim X As Integer, CY As Long
	'カラム番号取得
	GetColumn = UCase(GetColumn)
	If GetColumn < "A" Or GetColumn > "O" Then
		'A~O以外はエラー
		Xlookup = "Err Column"
		Exit Function
	End If

	' calculate column Aが1列目とする
	X = Asc(UCase(GetColumn)) – 64
	'顧客名取得＆株 削除＆Trim
	CUST_NAME = Trim(Replace(CUST_NAME, "(株)", ""))
	'検索して見つかったY座標取得
	CY = find_string(CUST_NAME)
	If CY = 0 Then
		'見つからなかった場合
		Xlookup = "UnFound"
		Exit Function
	End If
	'見つかった場合は指定の列の値を返す
	Xlookup = Sheets("MST").Cells(CY, X)

End Function

Function find_string(NM As String)
	Dim Y As Long
	'見つからなかった場合はエラーにならないようにする
	On Error Resume Next
	If IsError(Sheets("MST").Cells.Find(What:=NM).Row) Then
		'見つからなかった場合はゼロを返す
		Y = 0
	Else
		'見つかった場合はY座標を返す
		Y = Sheets("MST").Cells.Find(What:=NM).Row
	End If

	On Error GoTo 0
	find_string = Y

End Function

自分用のメモ

Sub run()
	'引数：並べ替えのフィールド名、対象のシート名、Pivot実データの開始Y番号,TOP幾つまでを表示するか
	pivot_SORT_TOP "TITLE”, "Sheet4″, 5, 10
End Sub

'X軸は日付など、並び替え可能な項目であること
Sub pivot_SORT_TOP(CMname As String, pivot_sheet As String, Y As Long, TOP As Integer)

	Dim X As Long, CH As String

	Sheets(pivot_sheet).Select

	On Error Resume Next
	'縦の項目を一度、全部表示にする
	For i = 1 To ActiveSheet.PivotTables(1).PivotFields(CMname).PivotItems.Count
		ActiveSheet.PivotTables(1).PivotFields(CMname).PivotItems(i).Visible = True
	Next
	
	'Pivotの末列の座標を探す
	X = 2
	Do While Cells(Y – 1, X) <> "”: X = X + 1: Loop
	X = X – 1
	
	'横列の昇順並び替え
	Cells(Y – 1, 2).Select
	Selection.Sort Order1:=xlAscending, Type:=xlSortLabels, OrderCustom:=1, _
		Orientation:=xlLeftToRight, SortMethod:=xlPinYin
	
	'並び替えたい列を選択
	Cells(Y, X).Select
	'Range(Chr(64 + X) & Y).Select
	
	'X,Y座標をR1C1形式に変換
	CH = "R” & Y & "C” & X
	'末列を降順でSORT
	Selection.Sort Key1:=CH, Order1:=xlDescending, Type:=xlSortValues, _
		OrderCustom:=1, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
	
	'表示項目がTOP指定より多い場合は、フィルター処理
	If ActiveSheet.PivotTables(1).PivotFields(CMname).PivotItems.Count > TOP Then
	
		On Error Resume Next
		'TOP以降は非表示する
		For i = TOP + 1 To ActiveSheet.PivotTables(1).PivotFields(CMname).PivotItems.Count
			ActiveSheet.PivotTables(1).PivotFields(CMname).PivotItems(i).Visible = False
		Next
	End If
	On Error GoTo 0
	
End Sub

'タイマーを止める時に使う為、グローバル定義
Dim Next_timer As Date
Sub Timer_set()
	'次回のタイマー呼び出しは1分後
	Next_timer = Now + TimeValue("00:01:00")
	'1分後に呼び出す処理を登録
	Application.OnTime Next_timer, "Timer_go"

End Sub

Sub Timer_go()
	'1分後に呼ばれる処理を記述

End Sub

Sub Timer_stop()
	'登録済みのタイマーを止める処理（実行済みのタイマーなら意味なし）
	Application.OnTime Next_timer, Procedure:="Timer_go", Schedule:=False
	'注意：実行済みで呼ばれた場合エラーとなるため、on error resume nextなどが推奨

End Sub

Sub sheet_protect()
	'sheetのプロテクト　パスワード：ABC
	ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=“ABC"
	'プロテクト解除
	ActiveSheet.Unprotect (“ABC")
End Sub