解析エンジニアの自動化 blog

コツコツと自動化した方法を残す blog

VBA によるテキスト処理




こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。




この記事の目次




目的


VBAを始めようとして、とりあえず『VBA』でインターネット検索をすると、『集計作業』、『報告書の作成作業』から始めると良いですよ!と書いてあるWebサイトが多々ありました。(筆者調べ)

そこで、報告書を作成するVBAは既にあるのですが、ソースコードもエクセルも整理されていないので、ここでちょっと整理して1つにまとめてみようと思います。

まとめ方としては、こんな感じでしょうかね。
①ファイル入力
②テキスト処理
③ファイル出力

この記事は、テキスト処理!!




関数

テキスト読み込み

どんな集計作業も報告書作成も元になるファイルがあるわけで、そのファイルを読み込まないと始まりません。

ソースコード
〜テキスト読み込み〜

先ずはファイルパスからテキストを読み込みます。

ファイル入力のインターフェースは下の図1の様なインターフェースを想定しています。

図1 ファイル入力インターフェース


'Public Const ShName = "ファイル入力"
'Public Const fld行 = 8
'Public Const fil行 = 11
'Public Const Name列 = 3
'Public Const Path列 = 9

Public Const ShName1 = "メモリ"
Public Const txt行 = 1
Public Const txt列 = 1

Sub ファイルパスリボルブ()
    
    i = fil行
    With ThisWorkbook.Worksheets(ShName)
        
        fPath = .Calls(i, Path列).Value
        While fPath <> ""
            
            Call テキスト読込(fPath)
            
            ' ここに『テキスト処理関数』を追加する
            '************************
            
            
            
            '************************
            
            i = i + 1
            fPath = .Calls(i, Path列).Value
            
        Wend
        
    End With
    
End Sub

Sub テキスト読込(ByVal fPath)
    
    Dim n As Integer
    Dim i As Integer
    Dim txtLine As String
    Dim FSO As Object
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    If Not FSO.FileExists(fPath) Then
    
        MsgBox "ファイルが存在しません"
        Exit Sub
        
    End If
    
    i = txt行
    
    n = FreeFile
    Open fPath For Input As #n
    
    Do While Not EOF(n)
        Line Input #n, txtLine
        ThisWorkbook.Worksheets(ShName1).Cells(i, txt列).Value = txtLine
        i = i + 1
    Loop
    
    Close #n
    
    Set FSO = Nothing
    
End Sub

テキスト処理

上のソースコード①で Excel にテキストを読み込みました。
ですが、読み込んだだけでまだ何もしてません。
今、テキストを自然言語だとします。つまり、日本語の文章が書かれているという事です。
かなり Microsoft Word の機能が使えるので、ちょっと処理してみます。

ソースコード
〜Word出力〜

Microsoft Word の機能を使うために Word をExcel VBA から起動して、テキストを Word に出力してみます。

Function Excel2Word()
    
    Set WdApp = CreateObject("Word.Application")
    WdApp.Visible = True
    WdApp.documents.Add
    
    i = txt行
    
    txtLine = ThisWorkbook.Worksheets(ShName1).Cells(i, txt列).Value
    While txtLine <> ""
        WdApp.Selection.typetext Text:=txtLine
        i = i + 1
        txtLine = ThisWorkbook.Worksheets(ShName1).Cells(i, txt列).Value
    Wend
    
    Set Excel2Word = WdApp
    
    Set WdApp = Nothing
    
End Function

ソースコード
〜文カウント〜

Microsoft Word に出力した文章がどれだけの文で構成されているかをカウントしてみます。

Function 文カウント(ByVal WdApp)
    
    Set Doc = WdApp.ActiveDocument
    Set Rng = Doc.Paragraphs(1).Range
    
    i = 0
    
    For Each stc In Rng.Sentences
        
        i = i + 1
        
    Next
    
    文カウント = i
    
End Function

ソースコード
〜単語カウント〜

今度は Microsoft Word に出力した文章がどれだけの単語で構成されているかをカウントしてみます。
ただし、このコードだと文章を構成する単語数をカウントするので、単語の重複は無視した単語数になります。

Function 単語カウント(ByVal WdApp)
    
    Set Doc = WdApp.ActiveDocument
    Set Rng = Doc.Paragraphs(1).Range
    
    i = 0
    
    For Each wrd In Rng.Words
        
        i = i + 1
        
    Next
    
    単語カウント = i
    
End Function

使い方

ソースコード①で書いた『ファイルパスリボルブ』に記載しておいた "ここに『テキスト処理関数』を追加する" という箇所にテキスト処理関数を記載します。

Sub ファイルパスリボルブ()
    
    i = fil行
    With ThisWorkbook.Worksheets(ShName)
        
        fPath = .Calls(i, Path列).Value
        While fPath <> ""
            
            Call テキスト読込(fPath)
            
            ' ここに『テキスト処理関数』を追加する
            '************************
            Set WdApp = Excel2Word()
            文数 = 文カウント(WdApp)
            単語数 = 単語カウント(WdApp)
            '************************
            
            i = i + 1
            fPath = .Calls(i, Path列).Value
            
        Wend
        
    End With
    
End Sub




コメント

テキスト出力処理が未実装なので、このままではテキスト処理の結果が確認出来ない状態です。
早くファイル出力の内容をまとめます。




以上

VBA でユーザーインターフェースを高速作成




こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。




この記事の目次




目的


VBA を始めようとして、とりあえず『 VBA 』でインターネット検索をすると、『集計作業』、『報告書の作成作業』から始めると良いですよ!と書いてある Web サイトが多々ありました。(筆者調べ)

そこで、報告書を作成する VBA は既にあるのですが、ソースコードもエクセルも整理されていないので、ここでちょっと整理して1つにまとめてみようと思います。

まとめ方としては、こんな感じでしょうかね。
①ファイル入力
②テキスト処理
③ファイル出力

先ずは、ファイル入力から!!




関数

ファイル入力方法

どんな集計作業も報告書作成も作るために必要な作業を経てから作るわけです。

私は解析エンジニアなので、解析の報告書を作る事がほぼメインなのですが、解析結果のファイルから報告書を作ります。

なので、やはり解析結果のファイルを入力する VBA が必要になってきます。

しかし、問題があります。

解析といっても、何パターンも行うことだってあります。すると、解析結果のファイルは山のように出来ます。(゚o゚;;

1つの解決策としては1つのフォルダの中に山のような解析結果ファイルを全部入れてしまい、フォルダ内のファイルを全て集計して、報告書を作成するというフローです。

インターフェース

Excel のシートにインターフェースを作成します。
今回は下の図1の様なインターフェースを作成しました。

図1 インターフェース素案


これに機能とボタンを作成していきます。

ソースコード
〜フォルダ選択〜

先ずはフォルダ選択ボタンのためにフォルダ選択ダイアログを表示して、フォルダのパスを取得するサブルーチンを作成しましょう。

Public Const ShName = "ファイル入力"
Public Const fld行 = 8
Public Const fil行 = 11
Public Const Name列 = 3
Public Const Path列 = 9

Sub フォルダ選択()
   
   Dim dlg As FileDialog
   Dim fPath As String
   
   Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    
   ' キャンセルボタンクリック時にマクロを終了
   If dlg.Show = False Then
      Exit Sub
   Else
      ' フォルダーのフルパスを変数に格納
      fPath = dlg.SelectedItems(1)
      ThisWorkbook.Worksheets(ShName).Cells(fld行, Name列).Value = 名称抽出(fPath)
      ThisWorkbook.Worksheets(ShName).Cells(fld行, Path列).Value = fPath
   End If
   
   ' ソースコード②参照
   Call フォルダ内ファイル一覧(fPath)
   
End Sub

Function 名称抽出(ByVal fPath)
   
   pos = InStrRev(fPath, "¥")
   fName = Mid(fPath, pos + 1, 100)
   名称抽出 = fName
   
End Function

ソースコード
〜フォルダ内ファイル取得〜

次に選択したフォルダの中にあるファイルを取得しましょう。

Sub フォルダ内ファイル一覧(ByVal fPath)
    
    Dim f As Object
    
    With CreateObject("Scripting.FileSystemObject")
        cnt = 0
        For Each f In .GetFolder(fPath).Files
            ThisWorkbook.Worksheets(ShName).Cells(fil行 + cnt, Name列) = 名称抽出(f.Path)
            ThisWorkbook.Worksheets(ShName).Cells(fil行 + cnt, Path列) = f.Path
            cnt = cnt + 1
        Next f
    End With
    
End Sub

フォルダ選択ボタン作成

フォルダ選択ボタンを作成しましょう。
今回は下の図2の様なボタンを作成しました。
ボタンを作ったときにボタンに関連付ける関数選択ダイアログが表示されるので、『フォルダ選択』を選択します。

図2 フォルダ選択ボタン


ソースコード
〜ファイル選択〜

フォルダからのファイル入力機能はこれでオッケーですが、結局はファイルダイアログからファイルを1個ずつ選択する機能も必要になるでしょう。

Sub ファイル選択(ByVal 行)

    fPath = Application.GetOpenFileName()
   
    If fPath = False Then
        ThisWorkbook.ActiveSheet.Cells(行, Name列).Value = ""
        ThisWorkbook.ActiveSheet.Cells(行, Path列).Value = ""
    Else
        ThisWorkbook.ActiveSheet.Cells(行, Name列).Value = 名称抽出(fPath)
        ThisWorkbook.ActiveSheet.Cells(行, Path列).Value = fPath
    End If
   
End Sub

ファイル選択ボタン作成

ファイル選択ボタンを作成しましょう。
今回は下の図3の様なボタンを作成しました。
ボタンを作ったときにボタンに関連付ける関数選択ダイアログが表示されるので、『ファイル選択』を選択します。
しかし、ただ選択するだけでは動作しません。
ファイル選択関数には引数があります。ボタンに関連付ける関数に引数を渡すときには関数名の後ろに半角スペースを空けて引数を書き、シングルクォーテーションで囲みます。『'ファイル選択 1'』

図3 ファイル選択ボタン


コーディングのプチ技①

図3みたいにボタンを複数作るとき、2、3個作るのも面倒なのにボタンに関連付ける関数に引数が必要な時はやる気をなくします。
そこで、ボタンの作成も VBA にやってもらいましょう。

Sub フォームボタン作成()
    Btn出力行 = 11
    Btn出力列 = 20
    Btn作成数 = 9
    For i = Btn出力行 To Btn出力行 + Btn作成数 - 1
        With ThisWorkbook.Worksheets(ShName)
            Set NewBtn = .Buttons.Add(.Cells(i, Btn出力列).Left + 1, _
                                     .Cells(i, Btn出力列).Top + 1, _
                                     .Range(.Cells(i, Btn出力列), .Cells(i, Btn出力列 + 2)).Width - 2, _
                                     .Range(.Cells(i, Btn出力列), .Cells(i, Btn出力列 + 2)).Height - 2)
            OnAct = "'ファイル選択 " & i & "'"
            NewBtn.OnAction = OnAct
            NewBtn.Characters.text = "ファイル選択"
        End With
    Next i
End Sub

コーディングのプチ技②

コーディングのプチ技①でフォームボタンを複数作成出来ますが、もし、間違って100個も200個もフォームボタンを作成してしまった時のために、フォームボタンを削除する VBA も載せておきます。
ただこのコードだとフォルダ選択ボタンも全部消えちゃいますけどね。

Sub フォームボタン削除()
    For Each Btn In ThisWorkbook.Worksheets(ShName).Shapes
        If Btn.Name Like "Button *" Then
            Btn.Delete
        End If
    Next
End Sub




コメント

あとは Excel の3行目と4行目に処理ボタン用のスペースがあるので、メーンの処理コードを追加していきましょう。




以上

VBScript による PDF のテキスト抽出




こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。



この記事の目次




目的


PDF 形式のファイルからテキスト情報を抽出します。 Microsoft Office 製品ならテキスト、図、グラフなどはオブジェクトなので情報を取得出来ますが、PDF 、画像の中の文字列などは容易には取得出来ません。(私には)
Microsoft Office 製品もPDF Export が実装されたこともあり、比較的テキストデータを保持した PDF ファイルが多く流通するのではないかなぁ〜と思い、PDF 形式のファイルからテキスト情報抽出をやってみました。




関数

準備

やり方はサードパーティ(使い方合ってるか微妙)から PDF のテキスト抽出するプログラムが公開されているので、使っちゃいます。
プログラムは xdoc2txt.exe です。
聞いたことがある人も多いのではないでしょうか!!
ダウンロード出来る WEB ページの URL を載せたかったのですが、直リンクはマナー違反とか、いまいち載せていいのかわからなかったのであえてやめました。

なんとか下の①〜③をやって下さい。

① xdoc2txt ダウンロード
下記のどちらかがネットにありました。
・xdoc2txt 2.16.1 ( xd2tx2161_x64.zip ) - x64(64bit)版
・xdoc2txt 2.16.1 ( xd2tx2161.zip ) - x86(32bit)版
 私は 64bit 版をダウンロードしました。
 
②ダウンロードした .zip ファイルの解凍
右クリックの「すべて展開」で出来ます。
xd2tx2161_x64(64bit版ダウンロードの場合)というフォルダが出来ました。

③フォルダの作成
 xdoc2txt フォルダをデスクトップに作成します。
ディレクトリはこんな感じになるはずです。
 C:\Users\********\Desktop\xdoc2txt( ********* はPCによる)

作成した xdoc2txt フォルダの中身は以下の通りです。
xdoc2txt フォルダ
├xdoc2txt.vbs(コードは下記に示す)
└xd2tx2161_x64(②で解凍したやつ)

ソースコード

準備で作成した xdoc2txt フォルダの中に入れる xdoc2txt.vbs を書きます。

xdoc2txt.vbs

'---------------------------------------------------------------
' テキスト変換したいファイルの定義
'---------------------------------------------------------------
analysisFile = "C:\Sample.pdf"
 
'---------------------------------------------------------------
' WshShell の作成
'---------------------------------------------------------------
set WshShell = CreateObject("WScript.Shell")
 
'---------------------------------------------------------------
' 解析実行ファイルのディレクトリ定義
'---------------------------------------------------------------
xdocPath = " C:\Users\********\Desktop\xdoc2txt\xd2tx2161_x64\command\"
 
'---------------------------------------------------------------
' コマンドプロンプト用コマンド作成
'---------------------------------------------------------------
exCommand = xdocPath & "xdoc2txt -f " & analysisFile
 
'---------------------------------------------------------------
' コマンド実行
'---------------------------------------------------------------
set oExec = WshShell.Exec(exCommand)




コメント

xdoc2txt.vbs を実行すると analysisFile と同じディレクトリ(上記のソースの場合は "C:\" )に "Sample.pdf" のテキストが抽出されて "Sample.txt" というファイルが作成されました。




以上

◯VBScript による IE のフレームの document オブジェクトの取得




こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。



この記事の目次




目的


フレームの document オブジェクトを取得する関数を作成します。




関数

ソースコード

この関数は上位オブジェクトとフレーム名を引数で渡して、フレームの document オブジェクトを返す関数です。フレームが見つからなければ Nothing を返します。

getFrame-objUpper-FrameNameProperty.vbs

function getFrame(byval objUpper, byval FrameNameProperty)
   '-------------------------------
   '--- まず全フレームの取得 ---
   '-------------------------------
   Set objFrames = objIE.document.frames
   '--------------------------------------
   '--- フレームのドキュメント取得 ---
   '--------------------------------------
   Set objFrameDoc = objFrames(FrameNameProperty).Document
   '-------------------------------------------
   '--- 対象オブジェクトの有無確認 ---
   '-------------------------------------------
   if objFrameDoc is Nothing then
       Msgbox "name 属性が " & FrameNameProperty & "の frame は見つけることが出来ませんでした。"
       set getFrame = Nothing
   else
       set getFrame = objFrameDoc
   end if
end function

使い方

作成した getFrame-objUpper-FrameNameProperty.vbs ファイルを呼び出して使うプログラムを書きます。

main.vbs

'-----------------------------------------
'--- frame の document オブジェクトを取得 ---
'-----------------------------------------
   '--- 変数宣言 ---
   FrameNameProperty = "frame_name"
   '--- 実行 ---
   Set FrameDoc = getFrame(objUpper, FrameNameProperty)




コメント

これで、 main.vbs を実行すると引数で渡したフレームの document オブジェクトを返します。フレームが見つからない時は Nothing を返します。




以上

VBScript による IE 入力のタイミング制御




こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。



この記事の目次




目的


乱数で待ち時間を設定して、 VBScript の処理を止める関数を書きます。




関数

ソースコード

この関数は乱数を発生させる範囲を引数で渡して、 VBScript の処理を止める関数です。
『VBS』というフォルダの中に『myFunc』というフォルダを作成していて、自作した関数は全て『myFunc』フォルダに保存しています。

Waiting_a-b.vbs

function Waiting(ByVal a, ByVal b)
   '-------------------------------------------------------
   ' a 以上 b 以下の乱数を作成
   '-------------------------------------------------------
   Lambda = Int(Rnd()*(b-a+1)+a)
   '-------------------------------------------------------
   ' 待ち時間を作成
   '-------------------------------------------------------
   WaitTime = DateAdd("s", Lambda, Now)
   '-------------------------------------------------------
   ' 待ち
   '-------------------------------------------------------
   While Now < WaitTime
      WScript.Sleep 100
   Wend
end function

使い方

作成した Waiting_a-b.vbs ファイルを呼び出して使うプログラムを書きます。
このプログラムは『VBS』フォルダの直下に保存します。

main.vbs

'------------------------------------------------------------------------------
' 自作関数のインクルード
'------------------------------------------------------------------------------
call IncludeFunction()
 
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' IE を開く
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   '--- 変数宣言 ---
   targetURL = "https://transit.yahoo.co.jp/"
   '--- 実行 ---
   call newIE(targetURL)
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' IE オブジェクトを取得する
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   '--- 変数宣言 ---
   targetURL = "https://transit.yahoo.co.jp/"
   '--- 実行 ---
   Set objIE = getObjectIE(targetURL)
   if objIE is nothing then
      '--- オブジェクトが無いので強制終了 ---
      WScript.Quit
   else
      '--- 続行 ---
   end if
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' 文字列「 sfrom 」が含まれる input タグを取得する
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   '--- 変数宣言 ---
   TagName = "input"
   InString = "sfrom"
   '--- 実行 ---
   set sfrom = getTagByStr(objIE, TagName, InString)
   sfrom.value = "東京"
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' 変数「 a 」~変数「 b 」まででランダムに処理を待つ
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   '--- 変数宣言 ---
   a = 1
   b = 2
   '--- 実行 ---
   call Waiting(a, b)
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' 文字列「 sto 」が含まれる input タグを取得する
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   '--- 変数宣言 ---
   TagName = "input"
   InString = "sto"
   '--- 実行 ---
   set sto = getTagByStr(objIE, TagName, InString)
   sto.value = "品川"
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' 変数「 a 」~変数「 b 」まででランダムに処理を待つ
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   '--- 変数宣言 ---
   a = 1
   b = 2
   '--- 実行 ---
   call Waiting(a, b)
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' 文字列「 searchModuleSubmit 」が含まれる input タグを取得する
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   '--- 変数宣言 ---
   TagName = "input"
   InString = "searchModuleSubmit"
   '--- 実行 ---
   set Btn = getTagByStr(objIE, TagName, InString)
   Btn.Click
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' 路線検索結果のため、 IE ビジー状態を待つ
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   '--- 実行 ---
   call WaitForIE(objIE)

'------------------------------------------------------------------------------
' 終了通知
'------------------------------------------------------------------------------
AutoMsg wscript.scriptname & " の処理が完了しました。", 4
'------------------------------------------------------------------------------
' 自作関数をコールするサブルーチン
'------------------------------------------------------------------------------
sub IncludeFunction()
   '----------------------------------------------------------------------------
   ' 自分(=VBSファイル)のディレクトリを取得する
   '----------------------------------------------------------------------------
   FullPath = wscript.scriptfullname
   FileName = wscript.scriptname
   pathLen= len(FullPath) - len(FileName)
   crrDir = left(FullPath, pathLen)
   chiDir = "myFunc"
   crrDir = crrDir & chiDir
   '----------------------------------------------------------------------------
   ' ファイルシステムを扱うオブジェクトを作成
   '----------------------------------------------------------------------------
   Set objFileSys = CreateObject("Scripting.FileSystemObject")
   '----------------------------------------------------------------------------
   ' フォルダのオブジェクトを取得
   '----------------------------------------------------------------------------
   Set objFolder = objFileSys.GetFolder(crrDir)
   '----------------------------------------------------------------------------
   ' FolderオブジェクトのFilesプロパティからFileオブジェクトを取得
   '----------------------------------------------------------------------------
   For Each objFile In objFolder.Files
      '--------------------------------------------------------------------------
      ' 自作関数のコール
      '--------------------------------------------------------------------------
      FuncFile = objFile.Name
      if instr(1, FuncFile, ".txt") = 0 then
         Set objFile = objFileSys.OpenTextFile(crrDir & "\" & FuncFile)
         ExecuteGlobal objFile.ReadAll()
         objFile.Close
      end if
   Next
   '----------------------------------------------------------------------------
   ' メモリ解放
   '----------------------------------------------------------------------------
   Set objFile = Nothing
   Set objFolder = Nothing
   Set objFileSys = Nothing
end sub




コメント

main.vbs を実行すると IE を操作する間 7 秒〜 13 秒間でランダムに処理を待ちます。




以上

VBScript によるフォルダ内ファイル取得




こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。



この記事の目次




目的


指定したフォルダ内にあるファイル名を取得する関数を作成します。




関数

ソースコード

この関数はディレクトリを引数で渡して、渡したディレクトリ内の全ファイルの名前が格納された配列を返す関数です。ファイルが見つからなければ -1 を返します。
『VBS』というフォルダの中に『myFunc』というフォルダを作成していて、自作した関数は全て『myFunc』フォルダに保存しています。

getFileName_crrDir.vbs

Function getFileName(crrDir)

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

    ' 引数 crrDir のフォルダのオブジェクトを取得
    Set objFolder = objFileSys.GetFolder(crrDir)

    ' ファイルが無い場合
    IF objFolder.Files.Count = 0 then
        getFileName = -1
        Exit Function
    End IF

    ' FolderオブジェクトのFilesプロパティからFileオブジェクトを取得
    tmpFile = ""
    For Each objFile In objFolder.Files
        ' 取得したファイルのファイル名格納
        IF tmpFile = "" then
            tmpFile = objFile.Name
        Else
            tmpFile = tmpFile & "@" & objFile.Name
        End IF
    Next

    getFileName = split(tmpFile, "@")

    Set objFolder = Nothing
    Set objFileSys = Nothing

End Function

使い方

作成した getFileName_crrDir.vbs ファイルを呼び出して使うプログラムを書きます。
このプログラムは『VBS』フォルダの直下に保存します。

main.vbs

'------------------------------------------------------------------------------
' 自作関数のインクルード
'------------------------------------------------------------------------------
call IncludeFunction()

'---------------------------------------
'--- フォルダ内ファイルの取得 ---
'---------------------------------------
   '--- 変数宣言 ---
   crrDir = "C:¥Test¥Sample"
   '--- 実行 ---
   ArrFile = getFileName(crrDir)

   Msgbox Join(ArrFile, vbNewLine)

'------------------------------------------------------------------------------
' 終了通知
'------------------------------------------------------------------------------
MsgBox wscript.scriptname & " の処理が完了しました。"
'------------------------------------------------------------------------------
' 自作関数をコールするサブルーチン
'------------------------------------------------------------------------------
sub IncludeFunction()
   '----------------------------------------------------------------------------
   ' 自分(=VBSファイル)のディレクトリを取得する
   '----------------------------------------------------------------------------
   FullPath = wscript.scriptfullname
   FileName = wscript.scriptname
   pathLen= len(FullPath) - len(FileName)
   crrDir = left(FullPath, pathLen)
   chiDir = "myFunc"
   crrDir = crrDir & chiDir
   '----------------------------------------------------------------------------
   ' ファイルシステムを扱うオブジェクトを作成
   '----------------------------------------------------------------------------
   Set objFileSys = CreateObject("Scripting.FileSystemObject")
   '----------------------------------------------------------------------------
   ' フォルダのオブジェクトを取得
   '----------------------------------------------------------------------------
   Set objFolder = objFileSys.GetFolder(crrDir)
   '----------------------------------------------------------------------------
   ' FolderオブジェクトのFilesプロパティからFileオブジェクトを取得
   '----------------------------------------------------------------------------
   For Each objFile In objFolder.Files
      '--------------------------------------------------------------------------
      ' 自作関数のコール
      '--------------------------------------------------------------------------
      FuncFile = objFile.Name
      if instr(1, FuncFile, ".txt") = 0 then
         Set objFile = objFileSys.OpenTextFile(crrDir & "\" & FuncFile)
         ExecuteGlobal objFile.ReadAll()
         objFile.Close
      end if
   Next
   '----------------------------------------------------------------------------
   ' メモリ解放
   '----------------------------------------------------------------------------
   Set objFile = Nothing
   Set objFolder = Nothing
   Set objFileSys = Nothing
end sub




コメント

これで、 main.vbs を実行すると引数で渡したディレクトリ内の全ファイル名が格納された配列を返します。 ディレクトリ内のファイルが表示されたかと思います。 ファイルが見つからない時は -1 を返します。




以上

VBScript による IE の読み込み待ち




こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。



この記事の目次




目的


IE オブジェクトでWebページを操作している時にページ遷移が発生する場合は多いです。
ページ遷移中にクリックやテキスト入力をしても IE は操作を受け取れません。
そこで、ページ遷移の状態を監視し、ページ遷移と同期を取る関数を作成します。




関数

ソースコード

引数で渡された IE オブジェクトのビジー状態を確認して、ビジー状態なら処理を待ちます。
なお、『VBS』というフォルダの中に『myFunc』というフォルダを作成していて、自作した関数は全て『myFunc』フォルダに保存しています。

WaitForIE_objIE.vbs

Function WaitForIE(objIE)
   '------------------------------------------------------------
   ' ページが読み込まれるまで待つ
   '------------------------------------------------------------
   Do While objIE.Busy = True Or objIE.readyState <> 4
      WScript.Sleep 100
   Loop
End Function

使い方

作成した WaitForIE_objIE.vbs ファイルを呼び出して使うプログラムを書きます。
このプログラムは『VBS』フォルダの直下に保存します。

main.vbs

'------------------------------------------------------------------------------
' 自作関数のインクルード
'------------------------------------------------------------------------------
call IncludeFunction()
 
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' IE を開く
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   '--- 変数宣言 ---
   targetURL = "https://transit.yahoo.co.jp/"
   '--- 実行 ---
   call newIE(targetURL)
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' IE オブジェクトを取得する
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   '--- 変数宣言 ---
   targetURL = "https://transit.yahoo.co.jp/"
   '--- 実行 ---
   Set objIE = getObjectIE(targetURL)
   if objIE is nothing then
      '--- オブジェクトが無いので強制終了 ---
      WScript.Quit
   else
      '--- 続行 ---
   end if
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' 文字列「 sfrom 」が含まれる input タグを取得する
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   '--- 変数宣言 ---
   TagName = "input"
   InString = "sfrom"
   '--- 実行 ---
   set sfrom = getTagByStr(objIE, TagName, InString)
   sfrom.value = "東京"
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' 文字列「 sto 」が含まれる input タグを取得する
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   '--- 変数宣言 ---
   TagName = "input"
   InString = "sto"
   '--- 実行 ---
   set sto = getTagByStr(objIE, TagName, InString)
   sto.value = "品川"
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' 文字列「 searchModuleSubmit 」が含まれる input タグを取得する
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   '--- 変数宣言 ---
   TagName = "input"
   InString = "searchModuleSubmit"
   '--- 実行 ---
   set Btn = getTagByStr(objIE, TagName, InString)
   Btn.Click
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' 路線検索結果のため、 IE ビジー状態を待つ
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   '--- 実行 ---
   call WaitForIE(objIE)

'------------------------------------------------------------------------------
' 終了通知
'------------------------------------------------------------------------------
AutoMsg wscript.scriptname & " の処理が完了しました。", 4
'------------------------------------------------------------------------------
' 自作関数をコールするサブルーチン
'------------------------------------------------------------------------------
sub IncludeFunction()
   '----------------------------------------------------------------------------
   ' 自分(=VBSファイル)のディレクトリを取得する
   '----------------------------------------------------------------------------
   FullPath = wscript.scriptfullname
   FileName = wscript.scriptname
   pathLen= len(FullPath) - len(FileName)
   crrDir = left(FullPath, pathLen)
   chiDir = "myFunc"
   crrDir = crrDir & chiDir
   '----------------------------------------------------------------------------
   ' ファイルシステムを扱うオブジェクトを作成
   '----------------------------------------------------------------------------
   Set objFileSys = CreateObject("Scripting.FileSystemObject")
   '----------------------------------------------------------------------------
   ' フォルダのオブジェクトを取得
   '----------------------------------------------------------------------------
   Set objFolder = objFileSys.GetFolder(crrDir)
   '----------------------------------------------------------------------------
   ' FolderオブジェクトのFilesプロパティからFileオブジェクトを取得
   '----------------------------------------------------------------------------
   For Each objFile In objFolder.Files
      '--------------------------------------------------------------------------
      ' 自作関数のコール
      '--------------------------------------------------------------------------
      FuncFile = objFile.Name
      if instr(1, FuncFile, ".txt") = 0 then
         Set objFile = objFileSys.OpenTextFile(crrDir & "\" & FuncFile)
         ExecuteGlobal objFile.ReadAll()
         objFile.Close
      end if
   Next
   '----------------------------------------------------------------------------
   ' メモリ解放
   '----------------------------------------------------------------------------
   Set objFile = Nothing
   Set objFolder = Nothing
   Set objFileSys = Nothing
end sub




コメント

これで、 main.vbs を実行すると、路線検索結果が完全に表示されるまでプログラムは終了しません。
ページ遷移したら必ず入れましょ。




以上