Sub 各シートに新しい列を挿入して最終行までシート名を記載() Dim ws As Worksheet Dim lastRow As Long Dim newCol As Integer ' 各シートに対してループ For Each ws In Worksheets ' シートの最終行を取得 lastRow = ws.Cells(ws.Rows.Count, "A").End(x…

Sub 各シートにシート名をA1セルに記載() Dim ws As Worksheet ' 各シートに対してループ For Each ws In Worksheets ' 各シートのA1セルにシート名を記載 ws.Range("A1").Value = ws.Name Next wsEnd Sub

Sub アクティブブックのシートをまとめる() Dim ws As Worksheet Dim summarySheet As Worksheet Dim lastRowSummary As Long, lastRowSource As Long Dim lastCol As Long Dim sourceRange As Range, destinationRange As Range ' 新しいシートを作成 Set s…

On Error Resume Next Set objFSO = CreateObject("Scripting.FileSystemObject") ' スクリプトのフルパスを取得scriptPath = WScript.ScriptFullName ' スクリプトが存在するディレクトリを取得scriptFolder = objFSO.GetParentFolderName(scriptPath) ' フ…

@echo offset ExcelPath="C:\Program Files\Microsoft Office\root\Office16\EXCEL.EXE" REM Excelのインストールパスset ExcelFile="C:\パス\MyExcelFile.xlsm" REM Excelファイルのパスset VBAMacro="MyMacro" REM 実行したいVBAマクロの名前 start "" %Ex…

Set objExcel = CreateObject("Excel.Application")objExcel.Visible = False ' Excelウィンドウを非表示にする ' ExcelファイルのパスstrExcelPath = "C:\パス\MyExcelFile.xlsm" ' Excelファイルを開くSet objWorkbook = objExcel.Workbooks.Open(strExcel…

Set objShell = CreateObject("WScript.Shell")objShell.Run "Z:\Work\立ち上げたいバッチ.bat", 1, True

Sub 比較と記載() Dim ws As Worksheet Dim lastRow1, lastRow2 As Long Dim aRange As Range, cRange As Range Dim aValue As Variant, cValue As Variant Dim bColumn As Range, dColumn As Range Dim i As Long ' 対象のシートを設定 Set ws = ThisWorkbo…

Set objFSO = CreateObject("Scripting.FileSystemObject") ' ソースフォルダのパスを指定sourceFolder = "C:\パス\から\あなたの\ソース\フォルダ"'スクリプトが配置されているフォルダをソースフォルダとして指定'scriptFolder = Replace(WScript.ScriptFu…

Set objFSO = CreateObject("Scripting.FileSystemObject") ' ソースフォルダのパスを指定sourceFolder = "C:\パス\から\あなたの\ソース\フォルダ"'スクリプトが配置されているフォルダをソースフォルダとして指定'scriptFolder = Replace(WScript.ScriptFu…

Option Explicit Const BIF_NEWDIALOGSTYLE = &H40Const BIF_NONEWFOLDERBUTTON = &H200Const BIF_RETURNONLYFSDIRS = &H1 Const FOR_READING = 1Const FOR_WRITING = 2 Const TAG_BEGIN1 = "#@~^" Const TAG_BEGIN2 = "==" Const TAG_BEGIN2_OFFSET = 10 Co…

Option Explicit dim oEncoder, oFilesToEncode, file, sDest dim sFileOut, oFile, oEncFile, oFSO, i dim oStream, sSourceFile set oFilesToEncode = WScript.Arguments set oEncoder = CreateObject("Scripting.Encoder") For i = 0 to oFilesToEncode.C…

Option Explicit Sub GetDataFromAccessWithMultipleConditions() Dim conn As Object Dim rs As Object Dim ws As Worksheet Dim strSQL As String ' Accessデータベースへの接続 Set conn = CreateObject("ADODB.Connection") conn.ConnectionString = "Pr…

Sub CreatePivotTable() Dim wsData As Worksheet Dim wsPivot As Worksheet Dim rngData As Range Dim pvtTable As PivotTable Dim pvtField As PivotField ' データがあるワークシートを指定 Set wsData = Worksheets("Sheet1") ' シート名を適切に変更 ' …

Sub 抽出と取りまとめ() Dim ws原本 As Worksheet Dim ws結果 As Worksheet Dim dict As Object Dim lastRow As Long Dim i As Long Dim key As Variant ' シートの設定 Set ws原本 = ThisWorkbook.Sheets("Sheet1") ' オリジナルデータがあるシート名 Set w…

Sub HighlightAndConvertText() Dim ws As Worksheet Dim rng As Range Dim cell As Range Dim hasTarget As Boolean Dim convertedCount As Long ' 対象のシートを指定 Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適切に変更 ' 対象の範囲を指定…

Sub SearchAccessQueryWithMultipleParameters() Dim conn As Object Dim rs As Object Dim strSQL As String Dim strConnection As String Dim accessDBPath As String Dim searchValue1 As Variant Dim searchValue2 As Variant Dim searchValue3 As Varia…

Accessの強制終了 @echo offtaskkill /IM msaccess.exe /F Excelの強制終了 @echo offtaskkill /IM excel.exe /F

Option Explicit Sub CompareAndSaveData() Dim accessApp As Object Dim excelApp As Object Dim excelWorkbook As Object Dim accessTable As Object Dim excelWorksheet As Object Dim currentDate As String Dim newWorkbookPath As String ' Access デ…

Option Explicit Dim objFSO, objFolder, objFile, strSourceFolderPath, strDestinationPath ' 引数が渡されているか確認If WScript.Arguments.Count > 0 Then ' ドラッグ＆ドロップされたフォルダのパスを取得 strSourceFolderPath = WScript.Arguments(0)…

' フォルダのパスを指定folderPath = "Z:\Work" ' 出力ファイルのファイル名を指定outputFileName = "output.txt" ' ファイル一覧を取得Set objFSO = CreateObject("Scripting.FileSystemObject")Set objFolder = objFSO.GetFolder(folderPath)Set colFiles …

Option Explicit ' VBS スクリプトのディレクトリパスを取得Dim scriptDirscriptDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\")) ' フォルダとname.txtの相対パスを指定Dim folderPath, nameFilePathfolderPath = scriptDir ' …

@echo off:: BatchGotAdminnet session >nul 2>&1if %errorLevel% == 0 ( goto :gotAdmin) else ( goto :UACPrompt):UACPrompt echo Set UAC = CreateObject^("Shell.Application"^) > "%temp%\getadmin.vbs" set params = %*:"="" echo UAC.ShellExecute "c…

Const n = 8 ' パスワードの桁数Dim chars, upper, pointer, passwordDim logFilePath, logMessage chars = "abcdefghijkmnpqrstuvwxyz0123456789*-_"upper = Len(chars) Randomize For i = 1 To n pointer = Int(Rnd * upper) + 1 password = password + Mi…

Option ExplicitDim a, c, cn, cv, f, i, n, so, wa, x, ySet so = CreateObject("Scripting.FileSystemObject")Set wa = WScript.Arguments If wa.Count <> 1 or LCase(so.GetExtensionName(wa(0))) <> "csv" ThenMsgBox("ドラッグ＆ドロップできるのは、cs…

Sub 比較処理マクロ() Dim ws1 As Worksheet, ws2 As Worksheet, diffWs As Worksheet, addWs As Worksheet, delWs As Worksheet Dim lastRow1 As Long, lastRow2 As Long, i As Long, j As Long, k As Long Dim foundMatch As Boolean Dim currentTime As D…

Sub 選択メールの添付ファイル削除() Set myOlApp = CreateObject("Outlook.Application") Set myOlSel = myOlApp.ActiveExplorer.Selection If myOlSel.Count = 0 Then MsgBox "メールが選択されていません" Exit Sub End If If vbYes <> MsgBox(myOlSel.Co…

Sub SaveOutlookMessagesWithDifferentFilenames() Dim olApp As Object Dim olNamespace As Object Dim olFolder As Object Dim olItem As Object Dim strOutputFolder As String Dim fs As Object Dim outFile As Object Dim isSentByMe As Boolean ' Outl…

Outlookを開き、 「開発」タブを有効にする。 「Visual Basic」をクリックしてVBAエディタを開く。 「挿入」メニューから「モジュール」を選択して下記VBA貼り付け。 Sub RemoveAttachmentsFromSelectedEmails() Dim selectedItems As Selection Set selecte…

@echo offtitle MyLauncher :: ウィンドウの列数を変更（例: 100）mode con cols=100 :: ウィンドウの行数を変更（例: 30）mode con lines=30 set "Ph1=C:\Program Files\Google\Chrome\Application\chrome.exe"set "Ph2=D:\***\IDM.exe"set "Ph3=D:\***\Mer…