VBSのSendKeysを使用して、アプリを自動操作して動作確認した

VBSのSendKeysを使用して、アプリを自動操作して動作確認した
Option Explicit

dim objShell
dim objExec

main()


sub main()
 logPrint("[START]" & date & " " & time)

 allInitialize()
 init()
 startApp1()
 setLot "20200414","100"
 serSend "dummy_data.csv",1
 AppQuit()

 startApp2()
 setLot "20200414","100"
 serSend "dummy_data.csv",2
 AppQuit()

 msgbox("END")
 logPrint("[END]" & date & " " & time)
end sub

sub setLot(shipdate,shipcount)
 WScript.Sleep 500
 objShell.SendKeys "%fs"
 WScript.Sleep 500
 objShell.SendKeys shipdate
 WScript.Sleep 500
 objShell.SendKeys "{ENTER}"
 WScript.Sleep 500
 objShell.SendKeys shipcount
 WScript.Sleep 500
 objShell.SendKeys "{ENTER}"
end sub

sub AppQuit()
 WScript.Sleep 500
 objShell.SendKeys "%fq"
 WScript.Sleep 500
end sub



sub serSend(filename,mode)

 dim datafile
 dim x

 set datafile = new clsText

 datafile.FileName=filename
 datafile.ReadFile()

 for each x in datafile.LineData.Item
  sendSer(datafile.csvRead(x,0))
  WScript.Sleep 500
  if mode = 1 then
   sendSer(datafile.csvRead(x,1))
   WScript.Sleep 500
  end if
 next
end sub



sub init()
end sub

sub startApp1()

 Set objShell = WScript.CreateObject("WScript.Shell")
 Set objExec = objShell.Exec("SER_CHK.exe")
  ' 起動を待つ

 Do Until objShell.AppActivate(objExec.ProcessID)
     WScript.Sleep 1000
 Loop

 '機種選択
 objShell.SendKeys "{TAB}"
 WScript.Sleep 100
 objShell.SendKeys "{TAB}"
 WScript.Sleep 100
 objShell.SendKeys "{TAB}"
 WScript.Sleep 100
 objShell.SendKeys "{DOWN}"
 WScript.Sleep 100
 objShell.SendKeys "{TAB}"
 WScript.Sleep 100
 objShell.SendKeys "{ENTER}"
 WScript.Sleep 100


  ' ダイアログの表示を待つ
 Do Until objShell.AppActivate("作業者名登録")
     WScript.Sleep 100
 Loop
 '作業者名選択
 objShell.SendKeys "TEST"  
 WScript.Sleep 100
 objShell.SendKeys "{TAB}"  
 WScript.Sleep 100
 objShell.SendKeys "{ENTER}"  
 WScript.Sleep 1000
end sub

sub startApp2()

 Set objShell = WScript.CreateObject("WScript.Shell")
 Set objExec = objShell.Exec("SER_CHK.exe")
  ' 起動を待つ

 Do Until objShell.AppActivate(objExec.ProcessID)
     WScript.Sleep 1000
 Loop

 '機種選択
 objShell.SendKeys "{TAB}"
 WScript.Sleep 100
 objShell.SendKeys "{TAB}"
 WScript.Sleep 100
 objShell.SendKeys "{TAB}"
 WScript.Sleep 100
 objShell.SendKeys "{DOWN}"
 WScript.Sleep 100
 objShell.SendKeys "{DOWN}"'docomo製番２
 WScript.Sleep 100
 objShell.SendKeys "{TAB}"
 WScript.Sleep 100
 objShell.SendKeys "{ENTER}"
 WScript.Sleep 100


  ' ダイアログの表示を待つ
 Do Until objShell.AppActivate("作業者名登録")
     WScript.Sleep 100
 Loop
 '作業者名選択
 objShell.SendKeys "TEST"  
 WScript.Sleep 100
 objShell.SendKeys "{TAB}"  
 WScript.Sleep 100
 objShell.SendKeys "{ENTER}"  
 WScript.Sleep 1000
end sub


sub sendSer(dSer)
 logPrint("sendSer(" &dSer&")" & " " & time)
 WScript.Sleep 100
 objShell.SendKeys dSer
 WScript.Sleep 100
 objShell.SendKeys "{ENTER}"
 WScript.Sleep 100
end sub


class clsText

 dim LineData
 dim RDobjFile
 dim RDobjFso
 dim WRobjFso
 dim WRobjFile
 dim m_FileName

    Public Property Get FileName
        FileName = m_FileName
    End Property

    Public Property Let FileName(vData)
        m_FileName = vData
    End Property


    Private Sub Class_Initialize()
        set LineData = new ArrayList
  Set RDobjFso = CreateObject("Scripting.FileSystemObject")
  Set WRobjFso = CreateObject("Scripting.FileSystemObject")
    End Sub

    Private Sub Class_Terminate()
  Set RDobjFso = Nothing
  Set WRobjFso = Nothing
    End Sub

 Public Sub Clear
  LineData.Clear
 end sub

 public Function Count
  Count = LineData.Count
 end Function

 public Function Items(n)
  Items = LineData.Items(n)
 end Function

 'CSV形式の１行から指定した列を取り出す(列番号は0から)
 function csvRead(str,n)
  dim rdline
  dim ret
  rdline = split(str,",")
  ret = rdline(n)
  csvRead = ret
 end function

 '読み込んだCSVファイルのy行x列を取り出す。x,yは0始まり
 function csvReadXY(x,y)
  csvReadXY = csvRead(LineData.Items(y),x)
 end function

 public Sub Change(i,x)
  LineData.Change i,x
 end sub

 Public Sub ReadFile
  Set RDobjFile = RDobjFso.OpenTextFile(m_FileName, 1, False)
  If Err.Number > 0 Then
      WScript.Echo "Open Error"
  Else
      Do Until RDobjFile.AtEndOfStream
          LineData.add RDobjFile.ReadLine
      Loop
  End If
  RDobjFile.Close
  Set RDobjFile = Nothing
 end sub

 Public Sub WriteFile
  Set WRobjFile = WRobjFso.OpenTextFile(m_FileName, 2, True)
  If Err.Number > 0 Then
      WScript.Echo "Open Error"
  Else
   dim item
   for each item in LineData.item
        WRobjFile.WriteLine item
   next
  End If
  WRobjFile.Close
  Set WRobjFile = Nothing
 end sub

 Public Sub AppendFile
  Set WRobjFile = WRobjFso.OpenTextFile(m_FileName, 8, True)
  If Err.Number > 0 Then
      WScript.Echo "Open Error"
  Else
   for each item in LineData.item
       WRobjFile.WriteLine item
   next
  End If
  WRobjFile.Close
  Set WRobjFile = Nothing
 end sub

'Scripting.FileSystemObjectはファイル操作をするオブジェクトです。
'OpenTextFileでファイルを開きます。
'第1パラメータ→ 必ず指定します。
'第2パラメータ→ 1:読み取り専用、2:書き込み専用、8:ファイルの最後に書き込み
'第3パラメータ→ True(規定値):新しいファイルを作成する、False:新しいファイルを作成しない
'第4パラメータ→ 0(規定値):ASCII ファイルとして開く、-1:Unicode ファイルとして開く、-2:システムの既定値で開く
'ReadLineでテキストファイルを読み込みます。
'Closeでファイルをクローズします。

 sub OpenFileDialog(title)

     Dim obj, filename
     Set obj = CreateObject("Excel.Application")
     filename = obj.GetOpenFilename("ALL File,*.*",1,title)
     obj.Quit
     Set obj = Nothing
     If filename <> False Then
           m_FileName = filename
     End If

 end sub

end Class



'動的配列版ArrayList
class ArrayList

 private m_Item()
 private m_count

 public sub Add(x)
  ReDim Preserve m_item(m_count)
  If IsObject(x) Then
   set m_item(m_count) = x
  else
   m_item(m_count) = x
  end if
  m_count = m_count + 1
 end sub

 public sub Change(i,x)
  If IsObject(x) Then
   set m_item(i) = x
  else
   m_item(i) = x
  end if
 end sub

 public function Count
  Count = m_count
 end function

 public function Clear
  m_count=0
  Erase m_item
 end function

 public function Item
  Item = m_Item
 end function

 public function Items(n)
  If IsObject(m_Item(n)) Then
   set Items = m_Item(n)
  else
   Items = m_Item(n)
  end if
 end function

end class

sub allInitialize()
 Dim ObjFso

 Set ObjFso=WScript.CreateObject("Scripting.FileSystemObject")

' ファイルを削除
 objFso.DeleteFile apppath() +  "\DB\Dbl_Check.mdb",True

'ファイルをコピー
 objFso.CopyFile apppath() +  "\DB\Dbl_Check_空.mdb",apppath() + "\DB\Dbl_Check.mdb", True

 delFiles "Z:\XXX\DSER1"
 delFiles "Z:\XXX\DSER2"
 delFiles "C:\Data_Backup\XXX\DSER1"
 delFiles "C:\Data_Backup\XXX\DSER2"
 set ObjFso = Nothing

end sub


' objShell.SendKeys "^f"      ' Ctrl+Fで検索ダイアログの表示
' ' ダイアログの表示を待つ
' Do Until objShell.AppActivate("検索")
'   WScript.Sleep 100
' Loop
' objShell.SendKeys "WSH~"    ' WSHと入力してEnterキーを押す
' objShell.SendKeys "{ESC}"   ' ダイアログを閉じる
' WScript.Sleep 100
' objShell.AppActivate(objExec.ProcessID)
' objShell.SendKeys "+{END}"  ' Shift+End で行末まで選択
' objShell.SendKeys "^c"      ' Ctrl+Cでコピー
' objShell.SendKeys "%{F4}"   ' Alt+F4で終了


'現在のパスを返す
function apppath
    dim fso
    set fso = createObject("Scripting.FileSystemObject")
    apppath = fso.getParentFolderName(WScript.ScriptFullName)
end function


function dir(file)

    dim objFso

    Set objFso = CreateObject("Scripting.FileSystemObject")

    If objFso.FileExists(file) Then
        'WScript.Echo "ファイルが存在します"
        dir = true
    else
        dir = false
    End If

    Set objFso = Nothing

end function


'ファイル選択ダイアログを出す
function OpenFileDialog(title)

    Dim obj, filename
    Set obj = CreateObject("Excel.Application")
    filename = obj.GetOpenFilename("ALL File,*.*",1,title)
    obj.Quit
    Set obj = Nothing
    If filename <> False Then
          OpenFileDialog = filename
    End If

end function

'Include "Utility.vbs"  ' 外部ファイル「Library.vbs」を取込み
'
'Sub Include(ByVal strFile)
'  Dim objFSO , objStream , strDir
'
'  Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") 
'  strDir = objFSO.GetFile(WScript.ScriptFullName).ParentFolder 
'
'  Set objStream = objFSO.OpenTextFile(strDir & "\" & strFile, 1)
'
'  ExecuteGlobal objStream.ReadAll() 
'  objStream.Close 
'
'  Set objStream = Nothing 
'  Set objFSO = Nothing
'End Sub


sub mkdir(path)

 Dim ObjFso

 Set ObjFso=WScript.CreateObject("Scripting.FileSystemObject")

 If ObjFso.FolderExists(path) = False Then
  ObjFso.Createfolder(path)
 End If
 set ObjFso = Nothing

end sub


sub copy(strCopyFile,strCopyFolder)

 On Error Resume Next

 Dim objFSO          ' FileSystemObject
' Dim strCopyFile     ' コピー対象ファイル
' Dim strCopyFolder   ' コピー先フォルダ名

' strCopyFile = "C:\A*"
' strCopyFolder = "C:\Work"
 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
 If Err.Number = 0 Then
     ' コピー先フォルダが存在しないときは作成する
     If objFSO.FolderExists(strCopyFolder) <> True Then
         objFSO.CreateFolder(strCopyFolder)
     End If

     ' ファイルコピー
     objFSO.CopyFile strCopyFile, strCopyFolder, True
     If Err.Number = 0 Then
         WScript.Echo strCopyFile & " を " & _
             strCopyFolder & " にコピーしました。"
     Else
         WScript.Echo "エラー: " & Err.Description
     End If
 Else
     WScript.Echo "エラー: " & Err.Description
 End If

 Set objFSO = Nothing
end sub



sub shell(x)
'WScript.Shellオブジェクト名.Run "実行するコマンド",ウィンドウサイズ指定,同期モード指定
'
'ウィンドウサイズの指定は、コマンド実行時のウィンドウサイズを数値で指定する。
'指定できる値 実行時のウィンドウサイズ(状態)
'0 非表示
'1 通常ウィンドウ
'2 最小化
'3 最大化
'
'同期モード指定
'false:非同期
'True:同期
 logPrintln("shell(" + x + ")")
 dim objShell
 Set objShell = CreateObject("WScript.Shell")
 objShell.Run x,0,false
 Set objShell = Nothing

end sub
sub logPrintln(s)
 logPrint(s & vbcrlf)
end sub

sub logPrint(s)
 dim objFsoWR
 dim objFileWR
 dim LogFile
 dim SerialFieldNo


 LogFile = apppath & "\log.log"

 Set objFsoWR = CreateObject("Scripting.FileSystemObject")
 Set objFileWR = objFsoWR.OpenTextFile(LogFile, 8, True)

 If Err.Number > 0 Then
     WScript.Echo "Open Error"
 Else
  objFileWR.WriteLine s
 End If

 objFileWR.Close
 Set objFileWR = Nothing
 Set objFsoWR = Nothing

end sub



sub delFiles(folder)
 '// INIT
 Dim FSO
 Set FSO = WScript.CreateObject("Scripting.FileSystemObject")

 '// メイン処理開始
 'WScript.Echo  "日時" & vbTab & "サイズ" & vbTab & "ファイル名" & vbTab &  "フォルダパス"

 logPrintln "getFiles(" + folder + ")"

 logPrintln "FindFolder(" + folder + ")"

     If FSO.FolderExists(folder) Then
  FindFolder FSO.GetFolder(folder)
 end if

 '// 後処理
 Set FSO = Nothing
end sub


'//===================================================================
'// サブフォルダも再帰してファイルを削除
Sub FindFolder(ByVal objMainFolder)
    Dim objSubFolder
    Dim objFile

    Dim ObjFso

    Set ObjFso=WScript.CreateObject("Scripting.FileSystemObject")


    '// フォルダがあれば再帰
    For Each objSubFolder In objMainFolder.SubFolders
        FindFolder objSubFolder
    Next

    '// フォルダの中のファイル情報を表示　　：　日時　サイズ　ファイル名　フォルダパス
    For Each objFile In objMainFolder.files
        'WScript.Echo  objFile.DateLastModified & vbTab & objFile.Size & vbTab & objFile.Name & vbTab &  objFile.ParentFolder 
        logPrintln  objFile.DateLastModified & vbTab & objFile.Size & vbTab & objFile.Name & vbTab &  objFile.ParentFolder 
 objFso.DeleteFile objFile.ParentFolder & "\" & objFile.Name,true
    Next
    set ObjFso = Nothing

End Sub

コメント

コメントを投稿

このブログの人気の投稿

VB.NET 実行中のクラス名とメソッド名を取得

実行中のクラス名とメソッド名を取得する を参考にした。エラーをログ出力するときにクラスとメソッドを出せると便利 クラス名 Console.WriteLine(MyClass.GetType.ToString) メソッド名 Console.WriteLine(System.Reflection.MethodBase.GetCurrentMethod.Name) 実行中のメソッドをメソッド内で取得する こちらに書いてあった以下の方法を使うとさらに便利。共通メソッド化できる。エラー時にログ出力するときにつけておけば、メソッドの呼び出し元のメソッド名がわかって便利 Public Sub DebugWriteLineMethodName() Debug.WriteLine(New StackFrame(1).GetMethod.Name) End Sub
続きを読む

VB.net Dictionaryクラスの初期化

[ VB.NET ] From による List, Dictionary クラスの初期化 ( VB2010 ) より VB2010以降で使える 変換テーブルのコードが要らなくなって便利 ' List クラスの初期化 Dim list As New List(Of String) From { "Item1", "Item2" } ' Dictionary クラスの初期化 Dim dect As New Dictionary(Of Integer, String) From { {0, "Item1"}, {1, "Item2"} }
続きを読む

フルパスファイル名と日付をサブディレクトリ込みで取得する方法

フォルダに分かれた大量のファイルがあって、今日更新されたファイルを探したいとき、フルパス＋日付でファイル一覧が取れると、後は適当な処理で探せるのだが、DOSコマンドだけでやるのは意外と難しい。以下でBatファイルでやる方法が紹介されていました。 Win: サブディレクトリも含めて、ファイル一覧をフルパスで取得する方法 シンプルでいいですね。 「FullPath_date.bat」と名前をつけて保存しました。ファイル一覧をdir.txtに保存してくれます。 %%を%にするとコマンドラインでも実行できます
続きを読む