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
このブログを検索

臥龍の自分メモ

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

コメント

コメントを投稿

このブログの人気の投稿

Python OpenCVとWebカメラでバーコードリーダー

VB.net Dictionaryクラスの初期化

バッチファイル（.bat）を非表示・最小化した状態で起動する
