2023年7月31日月曜日

AA

setlocal enabledelayedexpansion
@echo off
cls
rem 変数を定義
SET EJOB=
rem ********************************************
rem * WinMerge FileCompare Report Batch
rem * WMREPOマン
rem * 作成日 2023.07.13 作成者:Sakaru.Manda(VMREPOマン)
rem * All Rights Reserved 2023.07.13- VMREPOマン
rem * 注意事項:「再配布、変更不可、利用許可要」
rem ********************************************
echo;
SET NEWPATH=%CD%\NEW
SET GENPATH=%CD%\GEN
SET REPPATH=%CD%
SET TXTTYPE=.txt
SET REPTYPE=.html
SET Member=test1
SET CMD="C:\Program Files\WinMerge\WinMergeU.exe"
SET IniFile=%CD%\list.txt

rem ********************************************
rem * 前提条件の確認
rem ********************************************

cscript /nologo bin\Check.vbs %IniFile% %%GENPATH% %%NEWPATH%
echo 戻り値: %ERRORLEVEL%
If %ERRORLEVEL% equ 9 (
 echo チェックエラー
 pause
 exit
)

CALL :INIT !%IniFile!
CALL :IsGENFdrExist !%IniFile!
CALL :IsNEWFdrExist !%IniFile!

echo =====================================
echo  [WinMerge File Compare Report]
echo  All Rights Reserved 2023- VMREPOマン
echo  :
echo  カレント:%CD%
echo  実行:%~0
echo  使用日時:%DATE% %TIME%
echo  利用者 :%USERNAME%
echo    (現):%GENPATH%
echo    (新):%NEWPATH%
echo    結果ファイル:%REPPATH%
echo    注意(結果ファイル作成後は、加工処理要)
echo =====================================
SET /P ANSWER="実行します?(Y/N)"
if /i {%ANSWER%}=={y} (goto :yes)
if /i {%ANSWER%}=={yes} (goto :yes)
EXIT
:yes
@echo off
set /a n=0
ECHO ***** %DATE% %TIME% 処理開始 %n% 件 ****'
FOR /F %%a IN (list.txt) DO (
    SET Member=%%a
    SET NewFile=%NEWPATH%\!Member!%TXTTYPE%
    SET GenFile=%GENPATH%\!Member!%TXTTYPE%
    SET RepFile=%REPPATH%\!Member!%REPTYPE%
    
    %CMD% !NewFile! !GenFile! /minimize /noninteractive /u /or !RepFile!
    echo !ERRORLEVEL!
    SET /a n=n+1
)
ECHO .
ECHO ***** %DATE% %TIME% 処理終了 %n% 件 ****'
ECHO .
pause
EXIT /b 0

rem --------------------------------------------
rem * 初期処理
rem --------------------------------------------
:INIT
IF NOT EXIST %GENPATH% (
  echo %GENPATH% フォルダなし
  pause
  EXIT
)
IF NOT EXIST %NEWPATH% (
  echo %NEWPATH% フォルダなし
  pause
  EXIT
)
IF NOT EXIST %IniFile% (
  echo %IniFile% ファイルなし
  pause
  EXIT
)
EXIT /b

rem --------------------------------------------
rem * 現FDRにファイルが存在するかチェック
rem --------------------------------------------
:IsGENFdrExist
FOR /F %%a IN (list.txt) DO (
  SET FileNm=%%a
  IF NOT EXIST %GENPATH%\!FileNm!.txt (
     echo フォルダ  %GENPATH%\!FileNm!.txt なし
     pause
     goto:GENERR
  )
)
:GENERR
EXIT /b

rem --------------------------------------------
rem * 新FDRにファイルが存在するかチェック
rem --------------------------------------------
:IsNEWFdrExist
FOR /F %%a IN (list.txt) DO (
  SET FileNm=%%a
  IF NOT EXIST %NEWPATH%\!FileNm!.txt (
     echo フォルダ  %NEWPATH%\!FileNm!.txt なし
     pause
     goto:NEWERR
  )
)
:NEWERR
EXIT /b

endlocal


Option Explicit
'----------------------------------------------------
' Main
'----------------------------------------------------
Dim Args, sArg1, sArg2, sArg3
Dim iCnt
Dim sPathIn
Dim sBasePath
Set Args = WScript.Arguments
If Args.Count < 1 Then
  WScript.Echo "ドラッグ&ドロップしてを実行。"
  WScript.Quit
End If
sArg1 =  Wscript.Arguments(0)
sArg2 =  Wscript.Arguments(1)
sArg3 =  Wscript.Arguments(2)
'***************************************************
'WScript.Echo Args.Count
'WScript.Echo sArg1
'***************************************************
Dim iICnt, iOKCnt, iNGCnt
Dim bRC
bRC = IsFileExits(sArg1,sArg2)
WScript.Echo ""
If bRC <> 1 Then
   WScript.Echo "異常"
   WScript.Quit (9)
End If

bRC = IsFileExits(sArg1,sArg3)
WScript.Echo ""
If bRC <> 1 Then
   WScript.Echo "異常"
   WScript.Quit (9)
End If

WScript.Quit (0)
'----------------------------------------------------
' ファイルの存在確認
'----------------------------------------------------
Function IsFileExits(sPathIn,sTgtFdr)
    Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Dim fs, fr
    Dim sIRec
    Dim sIFile, s
    Dim iIPos, iFPos, intSts, i
    Dim iOCnt

    IsFileExits = 0
    '---------------------------------------
    WScript.Echo "sPathIn  :" & sPathIn
    WScript.Echo "sTgtFdr :" & sTgtFdr
    WScript.Echo ""
    '---------------------------------------
    Set fs = CreateObject("Scripting.FileSystemObject")
    ' *****************************************************************
    ' 検索先1
    If Not (fs.FolderExists(sTgtFdr)) Then
       EXIT FUNCTION
    End If

    ' 入力テキストファイルの内容のファイルが存在するか確認する
    If  fs.FileExists(sPathIn) Then
        Set fr = fs.OpenTextFile(sPathIn, ForReading)
        iICnt = 0:iOKCnt = 0:iNGCnt = 0
        Do While Not fr.AtEndOfStream
            sIRec = fr.ReadLine
            If fs.FileExists(sTgtFdr & "\" & Trim(sIRec) & ".txt") Then
               iOKCnt = iOKCnt + 1
            Else
               iNGCnt = iNGCnt + 1
            End If
            iICnt = iICnt + 1
        Loop
        WScript.Echo sTgtFdr & "行数入力:" & iICnt& " OK:" & iOKCnt  & " NG:" & iNGCnt
        fr.Close
        Set fr = Nothing
    Else
        'Call MsgBox("入力テキストファイルが存在しない!", 48, "エラー")
        IsFileExits = 0
    End If
    Set fs = Nothing

    If iICnt = iOKCnt Then
       IsFileExits = 1
    End If
End Function




2023年7月16日日曜日

PQ

 Sub Macro1()
'
' Macro1 Macro
' https://excel-ubara.com/excelvba4/EXCEL_VBA_408.html
'https://officeforest.org/wp/2022/10/03/vba%E3%81%A7power-query%E3%81%AE%E3%82%AF%E3%82%A8%E3%83%AA%E3%82%92%E4%BD%9C%E6%88%90%E3%83%BB%E5%89%8A%E9%99%A4%E3%81%99%E3%82%8B%E6%96%B9%E6%B3%95/
'
    'クエリをすべて削除する
    'ワークシートに接続
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    Dim qry As WorkbookQuery
    
    For Each qry In wb.Queries
        qry.Delete
    Next
    
    '---------------------------------
    
    Dim sSRC As String
    
    sSRC = "C:\Users\forza1063\Desktop\WMREPOマン\QB7.html"
    
        ActiveWorkbook.Queries.Add Name:="Table 0 (2)", _
        Formula:= _
        "let" & Chr(13) & "" & Chr(10) & _
        "    ソース = Web.Page(File.Contents(""C:\Users\forza1063\Desktop\WMREPOマン\QB7.html""))," & Chr(13) & "" & Chr(10) & _
        "    Data0 = ソース{0}[Data]," & Chr(13) & "" & Chr(10) & _
        "    変更された型 = Table.TransformColumnTypes(Data0,{{""C:\Users\forza1063\Desktop\WMREPOマン\NEW\QB7.txt"", type text}, {""C:\Users\forza1063\Desktop\WMREPOマン\NEW\QB7.txt2"", type text}, {""C:\Users\forza1063\Desktop\WMREPOマン\GEN\QB7.txt"", type text}, {""C" & _
        ":\Users\forza1063\Desktop\WMREPOマン\GEN\QB7.txt2"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    変更された型" & _
        ""
    
    'ActiveWorkbook.Queries.Add Name:="Table 0 (2)", _
    '    Formula:= _
    '    "let" & Chr(13) & "" & Chr(10) & _
    '    "    ソース = Web.Page(File.Contents(""C:\Users\forza1063\Desktop\WMREPOマン\QB7.html""))," & Chr(13) & "" & Chr(10) & _
    '    "    Data0 = ソース{0}[Data]," & Chr(13) & "" & Chr(10) & _
    '    "    変更された型 = Table.TransformColumnTypes(Data0,{{""C:\Users\forza1063\Desktop\WMREPOマン\NEW\QB7.txt"", type text}, {""C:\Users\forza1063\Desktop\WMREPOマン\NEW\QB7.txt2"", type text}, {""C:\Users\forza1063\Desktop\WMREPOマン\GEN\QB7.txt"", type text}, {""C" & _
    '    ":\Users\forza1063\Desktop\WMREPOマン\GEN\QB7.txt2"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    変更された型" & _
    '    ""
    
        'ActiveWorkbook.Queries.Add Name:="Table 0 (2)", _
        'Formula:= _
        '"let" & Chr(13) & "" & Chr(10) & _
        '"    ソース = Web.Page(File.Contents(""C:\Users\forza1063\Desktop\WMREPOマン\QB7.html""))," & Chr(13) & "" & Chr(10) & _
        '"    Data0 = ソース{0}[Data]," & Chr(13) & "" & Chr(10) & _
        '"    変更された型 = Table.TransformColumnTypes(Data0,{{""C:\Users\forza1063\Desktop\WMREPOマン\NEW\QB7.txt"", type text}, {""C:\Users\forza1063\Desktop\WMREPOマン\NEW\QB7.txt2"", type text}, {""C:\Users\forza1063\Desktop\WMREPOマン\GEN\QB7.txt"", type text}, {""C" & _
        '":\Users\forza1063\Desktop\WMREPOマン\GEN\QB7.txt2"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    変更された型" & _
        '""
    'ActiveWorkbook.Queries.Add Name:="Table 0 (2)", Formula:= _
    '    "let" & Chr(13) & "" & Chr(10) & "    ソース = Web.Page(File.Contents(""C:\Users\forza1063\Desktop\WMREPOマン\QB7.html""))," & Chr(13) & "" & Chr(10) & "    Data0 = ソース{0}[Data]," & Chr(13) & "" & Chr(10) & "    変更された型 = Table.TransformColumnTypes(Data0,{{""C:\Users\forza1063\Desktop\WMREPOマン\NEW\QB7.txt"", type text}, {""C:\Users\forza1063\Desktop\WMREPOマン\NEW\QB7.txt2"", type text}, {""C:\Users\forza1063\Desktop\WMREPOマン\GEN\QB7.txt"", type text}, {""C" & _
    '    ":\Users\forza1063\Desktop\WMREPOマン\GEN\QB7.txt2"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    変更された型" & _
        ""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 0 (2)"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table 0 (2)]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
  '      .ListObject.DisplayName = "テーブル_Table_0__2"
        .Refresh BackgroundQuery:=False
    End With
    Sheets("Table 0 (2)").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Sheets("Table 0 (2)").Select
    ActiveSheet.ListObjects("テーブル_Table_0__2").ShowAutoFilterDropDown = False
    ActiveSheet.ListObjects("テーブル_Table_0__2").ShowAutoFilterDropDown = True
    ActiveSheet.ListObjects("テーブル_Table_0__2").ShowAutoFilterDropDown = False
    ActiveSheet.ListObjects("テーブル_Table_0__2").TableStyle = ""
    Range("B18").Select
End Sub

2023年7月13日木曜日

WM

rem ********************************************
rem * WinMerge FileCompare Report Batch
rem * WMREPOマン
rem * 作成日 2023.07.13 作成者:Sakaru.Manda(VMREPOマン)
rem * All Rights Reserved 2023.07.13- VMREPOマン
rem * 注意事項:「再配布、変更不可、利用許可要」
rem ********************************************
setlocal enabledelayedexpansion
@echo off
cls
rem 変数を定義
SET EJOB=
echo;
SET NEWPATH=%CD%\NEW
SET GENPATH=%CD%\GEN
SET REPPATH=%CD%
SET TXTTYPE=.txt
SET REPTYPE=.html
SET Member=test1
SET CMD="C:\Program Files\WinMerge\WinMergeU.exe"
SET IniFile=%CD%\list.txt

IF NOT EXIST %NEWPATH% (
  echo %NEWPATH% フォルダなし
  pause
  EXIT
)
IF NOT EXIST %GENPATH% (
  echo %GENPATH% フォルダなし
  pause
  EXIT
)
IF NOT EXIST %IniFile% (
  echo %IniFile% ファイルなし
  pause
  EXIT
)

IF %USERNAME%=forza1063 (
  echo %IniFile% ファイルなし
ELSE
  echo 利用権限がありません
  pause
  EXIT
)


echo =====================================
echo  [WinMerge File Compare Report]
echo  All Rights Reserved 2023- VMREPOマン
echo  :
echo  カレント:%CD%
echo  実行:%~0
echo  使用日時:%DATE% %TIME%
echo  利用者 :%USERNAME%
echo    比較ファイル(新):%NEWPATH%
echo    比較ファイル(現):%GENPATH%
echo    結果ファイル   :%REPPATH%
echo    注意(結果ファイル作成後は、加工処理要)
echo =====================================
SET /P ANSWER="実行します?(Y/N)"
if /i {%ANSWER%}=={y} (goto :yes)
if /i {%ANSWER%}=={yes} (goto :yes)
EXIT
:yes
@echo off
set /a n=0
ECHO ***** %DATE% %TIME% 処理開始 %n% 件 ****'
FOR /F %%a IN (list.txt) DO (
    SET Member=%%a
    SET NewFile=%NEWPATH%\!Member!%TXTTYPE%
    SET GenFile=%GENPATH%\!Member!%TXTTYPE%
    SET RepFile=%REPPATH%\!Member!%REPTYPE%
    
    %CMD% !NewFile! !GenFile! /minimize /noninteractive /u /or !RepFile!
    echo !ERRORLEVEL!
    SET /a n=n+1
)
ECHO .
ECHO ***** %DATE% %TIME% 処理終了 %n% 件 ****'
ECHO .
pause
EXIT /b 0
endlocal



2023年7月9日日曜日

bunnkatu

 setlocal enabledelayedexpansion
rem *********************************************
rem * JOBLOG 件数出力
rem *     DRAG&DROP マルチファイル対応
rem * UPDATE 2023/07/08
rem *********************************************
@echo off
cls
rem echo %1
rem echo %~0
echo ---------------------------------------------
echo  ログからE件数とファイル情報を出力  Ver1.8
echo  %~nx0
echo  %~dp1
echo ---------------------------------------------
echo;
SET /P ANSWER="実行します。よろしいですか (Y/N)?"
if /i {%ANSWER%}=={y} (goto :yes)
if /i {%ANSWER%}=={yes} (goto :yes)
EXIT /b
:yes
  FOR %%a IN (%*) DO (
    cscript /nologo bin\RecSplit.vbs %%a
  )
  pause
endlocal

Option Explicit
'----------------------------------------------------
' Main
'----------------------------------------------------
Dim Args, sArg1
Dim iCnt

Set Args = WScript.Arguments
If Args.Count < 1 Then
  WScript.Echo "ドラッグ&ドロップしてを実行。"
  WScript.Quit
End If
'WScript.Echo Args.Count
'WScript.Echo sArg1
sArg1 =  Wscript.Arguments(0)
iCnt = SelectKenSu(sArg1)
WScript.Echo ""
If iCnt <> 0 Then
   WScript.Echo "正常 数:" & iCnt & " 件"
Else
   WScript.Echo "異常 数:" & iCnt & " 件"
End If
WScript.Quit (0)
'----------------------------------------------------
' 分割出力
'----------------------------------------------------
Function SelectKenSu(sArg1)
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim sPathIn, sPathOut, sBasePath
Dim fs, fr, fw
Dim sIRec, sORec
Dim sIFile, sOFile, s
    Dim iICnt, iOCnt, iMaxCnt
Dim iIPos, iFPos, intSts, i
Dim iOLRECL

    iOLRECL = 10
SelectKenSu = 0
    sPathIn = sArg1

    iFPos = InStrRev(sPathIn, "\")
    sBasePath = Left(sPathIn,iFPos -1)
    sIFile = Mid(sPathIn,iFPos + 1)
    'sOFile = "結果_" & sIFile & ".txt"
    sOFile = sIFile & ".txt"
    '---------------------------------------
    WScript.Echo "BASEPath  :" & sBasePath 
    WScript.Echo "入力FILE :" & sIFile
    WScript.Echo "出力FILE :" & sOFile
    WScript.Echo ""
    '---------------------------------------
    sPathIn  = sBasePath & "\" & sIFile
    sPathOut = sBasePath & "\結果\" & sOFile

    Set fs = CreateObject("Scripting.FileSystemObject")
    If Not (fs.FolderExists(sBasePath & "\結果")) Then
fs.CreateFolder(sBasePath & "\結果")
    End If
    
    If  fs.FileExists(sPathIn) Then
        Set fr = fs.OpenTextFile(sPathIn, ForReading)
        Set fw = fs.OpenTextFile(sPathOut, ForWriting, True)
        iICnt = 1
        Do While Not fr.AtEndOfStream
            sIRec = fr.ReadLine
            iMaxCnt = len(sIRec)/iOLRECL
            iIPos = 1
            For i = 1 To iMaxCnt
                  sORec = Mid(sIRec,iIPos,iOLRECL)
                  fw.WriteLine sORec
                  iOCnt = iOCnt + 1
                  iIPos = iIPos + iOLRECL
            Next
            iICnt = iICnt + 1
        Loop
        WScript.Echo "入力行数:" & iICnt
        WScript.Echo "出力行数:" & iOCnt
        fr.Close:fw.Close
        Set fr = Nothing:Set fw = Nothing
        intSts = 0
    Else
        'Call MsgBox("テキストが見つからない!", 48, "エラー")
        intSts = 1
    End If
    Set fs = Nothing
    SelectKenSu = iOCnt
End Function