KOTUKOTU-NOTES

FormatDateTimeを使うと、日時のデータを文字列で表示できます。

第二引数で表示形式を指定します。 設定値と表示形式は、下記のコードのコメント部分を確認してください。

Dim dt
dt = Now

'①標準の日付と時刻の表示形式（日付と時刻）→ "YYYY/MM/DD HH:mm:SS"
WScript.Echo  FormatDateTime(dt, vbGeneralDate)

'②長い日付形式　→"YYYY年M月D日"
WScript.Echo  FormatDateTime(dt, vbLongDate)

'③短い日付形式　→"YYYY/MM/DD"
WScript.Echo  FormatDateTime(dt, vbShortDate)

'④長い時刻形式　→"HH:mm:SS"
WScript.Echo  FormatDateTime(dt, vbLongTime)

'⑤短い時刻形式　→"HH:mm"
WScript.Echo   FormatDateTime(dt, vbShortTime)

以下のように、vbGeneralDate等の代わりに数値で書いても変換できます。 

Dim dt
dt = Now

'①標準の日付と時刻の表示形式（日付と時刻）→ "YYYY/MM/DD HH:mm:SS"
WScript.Echo FormatDateTime(dt, 0)		'0:vbGeneralDate

'②長い日付形式　→"YYYY年M月D日"
WScript.Echo FormatDateTime(dt, 1)		'1:vbLongDate

'③短い日付形式　→"YYYY/MM/DD"
WScript.Echo FormatDateTime(dt, 2)		'2:vbShortDate

'④長い時刻形式　→"HH:mm:SS"
WScript.Echo FormatDateTime(dt, 3)		'3:vbLongTime

'⑤短い時刻形式　→"HH:mm"
WScript.Echo FormatDateTime(dt, 4)		'4:vbShortTime

概要

VBScriptで日付を取得する方法です。
以下の日付を取得するサンプルです。 

• 今日、昨日、明日 の日付
  
• 一週間前と後　の日付
• 一か月前と後　の日付
• 一年前と後　の日付

コード

Dim today, yesterday, tomorrow, oneWeekAgo, oneWeekLater, oneMonthAgo, oneMonthLater, oneYearAgo, oneYearLater
today = Date()
yesterday = DateAdd("d", -1, today)
tomorrow = DateAdd("d", 1, today)
oneWeekAgo = DateAdd("ww", -1, today)
oneWeekLater = DateAdd("ww", 1, today)
oneMonthAgo = DateAdd("m", -1, today)
oneMonthLater = DateAdd("m", 1, today)
oneYearAgo = DateAdd("yyyy", -1, today)
oneYearLater = DateAdd("yyyy", 1, today)

Dim output
output = "今日の日付: " & today & vbCrLf
output = output & "昨日の日付: " & yesterday & vbCrLf
output = output & "明日の日付: " & tomorrow & vbCrLf
output = output & "一週間前の日付: " & oneWeekAgo & vbCrLf
output = output & "一週間後の日付: " & oneWeekLater & vbCrLf
output = output & "一か月前の日付: " & oneMonthAgo & vbCrLf
output = output & "一か月後の日付: " & oneMonthLater & vbCrLf
output = output & "一年前の日付: " & oneYearAgo & vbCrLf
output = output & "一年後の日付: " & oneYearLater

MsgBox output

概要

指定したフォルダ内の以下の情報をCSVファイルに出力します。

Dim fso, folder, files, file
Dim csvFilePath, csvFile, suffix

' WScript オブジェクトを作成
Set WshShell = CreateObject("WScript.Shell")

' デスクトップのパスを取得
desktopPath = WshShell.SpecialFolders("Desktop")

' フォルダ選択ダイアログを表示して、処理対象のフォルダを取得
Set shell = CreateObject("Shell.Application")
Set selectedFolder = shell.BrowseForFolder(0, "フォルダを選択", 0, desktopPath)

' フォルダが選択された場合のみ処理を実行
If Not selectedFolder Is Nothing Then
    ' 出力するCSVファイルのパス
    csvFilePath = "output.csv"

	' サフィックスの作成
    suffix = FormatDateTime(Now, vbGeneralDate)
    suffix = Replace(suffix, "/", "")
    suffix = Replace(suffix, ":", "")
    suffix = Replace(suffix, " ", "")

    ' サフィックスをCSVファイル名に追加
    csvFilePath = Left(csvFilePath, Len(csvFilePath) - 4) & "_" & suffix & ".csv"

    ' ファイルシステムオブジェクトを作成
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' 指定したフォルダ内のファイルを取得
    Set folder = fso.GetFolder(selectedFolder.Self.Path)
    Set files = folder.Files

    ' CSVファイルを作成または既存のファイルを上書き
    Set csvFile = fso.CreateTextFile(csvFilePath, True)

    ' ヘッダ行をCSVファイルに書き込む
    csvFile.WriteLine("作成日,更新日,ファイル名,ファイルパス")

    ' ファイルごとに情報を取得してCSVファイルに書き込む
    For Each file In files
        ' ファイルの作成日、更新日、ファイル名、ファイルパスを取得し、CSVファイルに書き込む
        csvFile.WriteLine(FormatDateTime(file.DateCreated, 2) & "," & FormatDateTime(file.DateLastModified, 2) & "," & file.Name & "," & file.Path)
    Next

    ' CSVファイルを閉じる
    csvFile.Close

    ' メッセージボックスで完了を表示
    MsgBox "CSVファイルの出力が完了しました。"

    ' ファイルシステムオブジェクトを解放
    Set fso = Nothing
End If

補足

Option Explicit

Dim objFSO
Dim excelApp, workbook, worksheet
Dim searchStr, replaceStr, prefix
Dim filePath, newFilePath

' ファイルシステムオブジェクトを作成
Set objFSO = CreateObject("Scripting.FileSystemObject")

' プレフィックスを入力
prefix = InputBox("ファイル名に付けるプレフィックスを入力してください")

' 検索置換文字列を入力
searchStr = InputBox("検索する文字列を入力してください")
replaceStr = InputBox("置換する文字列を入力してください")

' エクセルアプリケーションオブジェクトを作成
Set excelApp = CreateObject("Excel.Application")
excelApp.Visible = False
excelApp.DisplayAlerts = False ' メッセージを非表示にする


' ドラッグ＆ドロップされたファイルの数だけ処理を繰り返す
For Each filePath in WScript.Arguments
    
    ' エクセルファイルを開く
    Set workbook = excelApp.Workbooks.Open(filePath)
    
    ' ドラッグ＆ドロップされたエクセルファイル内のシートの数だけ処理を繰り返す
    For Each worksheet In workbook.Sheets
        ' テキストの置換
        worksheet.Cells.Replace searchStr, replaceStr
    Next
    
    ' 別名で保存
    newFilePath = objFSO.GetParentFolderName(filePath) & "\" & prefix & "_" & objFSO.GetFileName(filePath)
    workbook.SaveAs newFilePath
    
    ' エクセルを閉じる
    workbook.Close
    
    ' エクセルアプリケーションを終了
    excelApp.Quit
    
    ' オブジェクトの解放
    Set worksheet = Nothing
    Set workbook = Nothing
Next

excelApp.Visible = True
excelApp.DisplayAlerts = True ' メッセージを非表示にする

Set excelApp = Nothing
Set objFSO = Nothing
Msgbox "置換処理終了"

フォルダ内のファイルをリストにして確認するスクリプトです。

下記のスクリプトをXXX(任意のファイル名).vbsで保存します。

保存したファイルをクリックすると、入力画面が表示されるので、調べたいフォルダのパスを入力して、OKを押してください。

すると、vbsがあるフォルダの中に、Files.xlsxという名前でファイルリストが作成されます。

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

Set objWorkbook = objExcel.Workbooks.Add()
Set objWorksheet = objWorkbook.Sheets(1)


' ヘッダー行の設定
objWorksheet.Cells(1, 1).Value = "フォルダパス"
objWorksheet.Cells(1, 2).Value = "ファイルパス"

intRow = 2 ' データ行の開始位置

' ユーザーからの入力を受け取る
strInput = InputBox("ファイルパスを入力:", "入力")

strFolderPath = strInput ' フォルダのパスを指定


' フォルダ内のファイルとフォルダを処理
ProcessFolder strFolderPath

' 出力したデータを自動調整
objWorksheet.UsedRange.Columns.AutoFit

' エクセルファイルを保存
' 実行中のスクリプトファイルのフルパスを取得
strScriptPath = WScript.ScriptFullName
 
' スクリプトファイルのディレクトリパスを取得
strScriptFolder = objFS.GetParentFolderName(strScriptPath)



strOutputFilePath = strScriptFolder & "\Files.xlsx" ' 出力先のファイルパスを指定
objWorkbook.SaveAs strOutputFilePath

' オブジェクトの参照を解放
Set objWorksheet = Nothing
objWorkbook.Close
objExcel.Quit
Set objExcel = Nothing

Set objFS = Nothing

'================================================================
' フォルダ内のファイルとサブフォルダを再帰的に処理するサブルーチン
'----------------------------------------------------------------
Sub ProcessFolder(strFolderPath)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strFolderPath)
    
    ' フォルダ内のファイルを処理
    For Each objFile In objFolder.Files
        ' ファイルパスを出力
        objWorksheet.Cells(intRow, 2).Value = objFile.Path
        intRow = intRow + 1
    Next
    
    ' サブフォルダを再帰的に処理
    For Each objSubFolder In objFolder.SubFolders
        ' フォルダパスを出力
        objWorksheet.Cells(intRow, 1).Value = objSubFolder.Path
        intRow = intRow + 1
        
        ' サブフォルダ内のファイルとサブフォルダを再帰的に処理
        ProcessFolder objSubFolder.Path
    Next
    
    ' オブジェクトの参照を解放
    Set objSubFolder = Nothing
    Set objFile = Nothing
    Set objFolder = Nothing
    Set objFSO = Nothing
End Sub
'==============================================================

大事な情報が書き込まれているファイルはパスワードを設定しますね。

しかし、何のパスワードを設定したか忘れてしまっては困ります。

今回は、

ドラッグ＆ドロップで

１．パスワードを自動生成
２.  パスワードを設定してエクセルを保存
３．設定したパスワードを別のエクセルファイルに書き込んで保存

というスクリプトを紹介します。

Set objFSO = CreateObject("Scripting.FileSystemObject")

'パスワード保存用のエクセルファイル
strOutputFilePath = "C:\Users\AKIKO\Desktop\簡単メール\パスワード.xlsx"

'パスワードの桁数
passKeta = 8


' ドラッグアンドドロップされたファイルパスを取得
For Each strFilePath In WScript.Arguments
    ' パスワードを自動生成する関数

    ' パスワードを自動生成
    strPassword = GeneratePassword(passKeta)  'パスワードを生成
    
    ' エクセルファイルを開く
    Set objExcel = CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Open(strFilePath)
    
    ' パスワードを設定して保存
    objWorkbook.Password = strPassword
    objWorkbook.Save
    
    ' 別のエクセルにファイルパスとパスワードを保存

    Set objOutputWorkbook = objExcel.Workbooks.Open(strOutputFilePath)
    Set objOutputWorksheet = objOutputWorkbook.Worksheets(1)
    
    ' 一番最後の行を取得
    intLastRow = objOutputWorksheet.Cells(objOutputWorksheet.Rows.Count, 1).End(-4162).Row + 1
    
    ' ファイルパスとパスワードを書き込む
    objOutputWorksheet.Cells(intLastRow, 1).Value = strFilePath
    objOutputWorksheet.Cells(intLastRow, 2).Value = strPassword
    
    ' ファイルを保存して閉じる
    objOutputWorkbook.Save
    objOutputWorkbook.Close
    objWorkbook.Close
    
    ' オブジェクトの参照を解放
    Set objOutputWorksheet = Nothing
    Set objOutputWorkbook = Nothing
    Set objWorkbook = Nothing
    Set objExcel = Nothing
Next

Set objFSO = Nothing
Set objShell = Nothing


    Function GeneratePassword(length)
        Const validChars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
        Dim password, i
        Randomize
        password = ""
        For i = 1 To length
            password = password & Mid(validChars, Int((Len(validChars) * Rnd) + 1), 1)
        Next
        GeneratePassword = password
    End Function

Findメソッド

概要:

Findメソッドは、Excelのワークシートや範囲内で特定の値を検索するためのメソッドです。検索結果として、最初に一致したセルを返します。

構文:

objWorksheetは 検索を行うワークシートオブジェクトです。
rangeは 検索を行う範囲のアドレスを指定します。

objWorksheet.Range(range).Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

引数:

• What: 検索する値を指定します。
• After (オプション): 検索を開始するセルの位置を指定します。省略すると、検索は範囲の先頭から開始されます。
• LookIn (オプション): 検索対象とする要素を指定します。省略すると、検索はセルの値に対して行われます。
• LookAt (オプション): 検索方法を指定します。省略すると、検索は部分一致で行われます。
• SearchOrder (オプション): 検索順序を指定します。省略すると、検索は行優先で行われます。
• SearchDirection (オプション): 検索方向を指定します。省略すると、検索は下方向に行われます。
• MatchCase (オプション): 大文字と小文字を区別するかどうかを指定します。省略すると、大文字と小文字は区別されません。
• MatchByte (オプション): バイト単位で一致するかどうかを指定します。省略すると、バイト単位で一致します。
• SearchFormat (オプション): 検索の書式を指定します。省略すると、書式は無視されます。

返り値:

Findメソッドは、検索結果として最初に一致したセルを返します。一致するセルが見つからなかった場合はNothingを返します。

使用例

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Path\to\Workbook.xlsx")
Set objWorksheet = objWorkbook.Worksheets(1)

' A1からA10の範囲で値が"Apple"と一致するセルを検索します
Set objResult = objWorksheet.Range("A1:A10").Find("Apple")

If Not objResult Is Nothing Then
    MsgBox "一致するセルが見つかりました: " & objResult

AutoFilterメソッド

概要:

AutoFilterメソッドは、Excelのワークシートのデータに対して自動フィルタを適用するためのメソッドです。自動フィルタを使用すると、データの特定の列に基づいて絞り込みやソートを行うことができます。

構文:

objWorksheet.Range(range).AutoFilter 
  field, criteria1, operator, criteria2, visibleDropDown

引数:

• field: フィルタを適用する列のインデックスまたは列のヘッダーの名前を指定します。
• criteria1: フィルタの条件を指定します。
• operator (オプション): criteria1とcriteria2の間の演算子を指定します。省略可能で、デフォルト値はxlAndです。
• criteria2 (オプション): フィルタの2番目の条件を指定します。operatorが指定されている場合に使用します。
• visibleDropDown (オプション): 自動フィルタのドロップダウン矢印の表示/非表示を指定します。省略可能で、デフォルト値はTrueです。

返り値:　なし

使用例

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Path\to\Workbook.xlsx")
Set objWorksheet = objWorkbook.Worksheets(1)

' 範囲A1からD10までに自動フィルタを適用します
objWorksheet.Range("A1:D10").AutoFilter 1, "Apple"

' オブジェクトの参照を解放します
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing

Deleteメソッド

概要:

Deleteメソッドは、Excelのワークシートや範囲から行や列を削除するためのメソッドです。

構文:

objWorksheet.Rows(row).Delete
objWorksheet.Columns(column).Delete
objWorksheet.Range(range).Delete

引数:

• objWorksheet: 行や列を削除するワークシートオブジェクトです。
• row: 削除する行の番号を指定します。
• column: 削除する列の番号を指定します。
• range: 削除する範囲のアドレスを指定します。

返り値:

Deleteメソッドは、削除操作が成功した場合には特定の値を返しません。

使用例

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Path\to\Workbook.xlsx")
Set objWorksheet = objWorkbook.Worksheets(1)

' 行の削除
objWorksheet.Rows(2).Delete

' 列の削除
objWorksheet.Columns(2).Delete

' 範囲の削除
objWorksheet.Range("A1:B5").Delete

' オブジェクトの参照を解放します
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing

Insertメソッド

概要:

Insertメソッドは、Excelのワークシートや範囲に行や列を挿入するためのメソッドです。挿入された行や列にはデフォルトの値が設定されます。

構文:

objWorksheet.Rows(row).Insert
objWorksheet.Columns(column).Insert
objWorksheet.Range(range).Insert

引数:

• objWorksheet: 行や列を挿入するワークシートオブジェクトです。
• row: 挿入する行の番号を指定します。
• column: 挿入する列の番号を指定します。
• range: 挿入する範囲のアドレスを指定します。

返り値:

Insertメソッドは、挿入操作が成功した場合には特定の値を返しません。

使用例

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Path\to\Workbook.xlsx")
Set objWorksheet = objWorkbook.Worksheets(1)

' 行の挿入
objWorksheet.Rows(2).Insert

' 列の挿入
objWorksheet.Columns(2).Insert

' 範囲の挿入
objWorksheet.Range("A1:B5").Insert

' オブジェクトの参照を解放します
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing