VBAのListViewで利用する共通関数(VBAでのListViewの設定方法)

 VBAのListViewが復活したいまさらながらに知ったので、共通関数として必要そうなものをつくってみた。共通モジュールに「modListView」を作って中に放り込んでおけばいろいろと使える・・・はず。

******* 画面での使い方 *******
Private Const COL_1_No As String = "_No"
Private Const COL_2_NAME As String = "_Name"
Private Const COL_3_COUNT As String = "_COUNT"
Private Sub CommandButton2_Click()
    Call SetData
End Sub
Private Sub LvSample_DblClick()
    MsgBox GetLvValueIdx(lvSample, lvSample.SelectedItem.Index, COL_1_No)
End Sub
Private Sub UserForm_Initialize()
    
    Call ControlInit
    
End Sub

Private Sub ControlInit()
    
    Call LvSample_Initialize
End Sub

'ListViewにテストデータを設定する
Private Sub SetData()
    lvSample.ListItems.Clear
    Dim i As Integer
    'データ設定方法1
    For i = 0 To 10
        lvSample.ListItems.Add
            
        Call SetLvValueIdx(lvSample, i + 1, COL_1_No, i)
        Call SetLvValueIdx(lvSample, i + 1, COL_2_NAME, "日本 太郎" & i)
        Call SetLvValueIdx(lvSample, i + 1, COL_3_COUNT, "1")
    Next
    
    'データ設定方法2
    Dim item As ListItem
    For i = 0 To 10
        
        Set item = lvSample.ListItems.Add
        
        Call SetLvValue(lvSample, item, COL_1_ATENA, "2 - " & i)
        Call SetLvValue(lvSample, item, COL_2_NAME, "日本 太郎2 - " & i)
        Call SetLvValue(lvSample, item, COL_3_COUNT, "1")
        '色変更サンプル
        If i = 1 Or i = 5 Then
            item.ForeColor = RGB(255, 0, 0)
        End If
        
        Set item = Nothing
        
    Next
End Sub

Private Sub LvSample_Initialize()
    
    'ListViewの共通プロパティ設定
    Call SetListViewProperty(lvSample)
    
    'ListViewの列を設定する
    With lvSample
        .ColumnHeaders.Add , COL_1_NO, "番号"
        .ColumnHeaders.Add , COL_2_NAME, "名前"
        .ColumnHeaders.Add , COL_3_COUNT, "数"
    End With
End Sub


*****************************

******* modListView の中身********
Public Sub SetListViewProperty(ByRef lv As ListView)
    With lv
        .View = lvwReport           ''表示
        .LabelEdit = lvwManual      ''ラベルの編集
        .HideSelection = False      ''選択の自動解除
        .AllowColumnReorder = True  ''列幅の変更を許可
        .FullRowSelect = False       ''行全体を選択
        .Gridlines = True           ''グリッド線
    End With
End Sub
'----------------------------------------------------------------------------------------------------------
'関数:列名からリストビューの値を取得する
'----------------------------------------------------------------------------------------------------------
Public Function GetLvValue(ByRef lv As ListView, ByRef lvItem As ListItem, ByVal strColKey As String) As String
    GetLvValue = ""
    
    Dim intColIdx As Integer
    intColIdx = GetColIdx(lv, strColKey)
    
    If intColIdx = -1 Then
        MsgBox "[エラー]関数の指定が間違っています。関数名:GetLvValue"
        Exit Function
    End If
    
    If intColIdx = 1 Then
        GetLvValue = lv.ListItems(lngItemIdx).Text
    Else
        GetLvValue = lv.ListItems(lngItemIdx).SubItems(intColIdx - 1)
    End If
    
End Function
'----------------------------------------------------------------------------------------------------------
'関数:列名からリストビューの値を取得する
'----------------------------------------------------------------------------------------------------------
Public Function GetLvValueIdx(ByRef lv As ListView, ByVal lngItemIdx As Long, ByVal strColKey As String) As String
    GetLvValueIdx = ""
    
    Dim intColIdx As Integer
    intColIdx = GetColIdx(lv, strColKey)
    
    If intColIdx = -1 Then
        MsgBox "[エラー]関数の指定が間違っています。関数名:GetLvValue"
        Exit Function
    End If
    
    If intColIdx = 1 Then
        GetLvValueIdx = lv.ListItems(lngItemIdx).Text
    Else
        GetLvValueIdx = lv.ListItems(lngItemIdx).SubItems(intColIdx - 1)
    End If
    
End Function

'----------------------------------------------------------------------------------------------------------
'関数:ListViewの指定項目の値を行Indexを指定して設定する
'----------------------------------------------------------------------------------------------------------
Public Sub SetLvValueIdx(ByRef lv As ListView, ByVal lngItemIdx As Long, ByVal strColKey As String, ByVal strValue As String)
    Dim intColIdx As Integer
    intColIdx = GetColIdx(lv, strColKey)
    
    If intColIdx = -1 Then
        MsgBox "[エラー]関数の指定が間違っています。関数名:SetLvValueIdx"
        Exit Sub
    End If
    
    If intColIdx = 1 Then
        lv.ListItems(lngItemIdx).Text = strValue
    Else
        lv.ListItems(lngItemIdx).SubItems(intColIdx - 1) = strValue
    End If
    
End Sub
'----------------------------------------------------------------------------------------------------------
'関数:ListViewの指定項目の値をListItemを指定して設定する
' 例: Dim item As ListItem
'       Set item = lvSample.ListItems.Add
'    Call SetLvValue(lvSample,item,"COL1_NAME","テスト 太郎")
'----------------------------------------------------------------------------------------------------------
Public Sub SetLvValue(ByRef lv As ListView, ByRef lvItem As ListItem, ByVal strColKey As String, ByVal strValue As String)
    Dim intColIdx As Integer
    intColIdx = GetColIdx(lv, strColKey)
    
    If intColIdx = -1 Then
        MsgBox "[エラー]関数の指定が間違っています。関数名:SetLvValue"
        Exit Sub
    End If
    
    If intColIdx = 1 Then
        lvItem.Text = strValue
    Else
        lvItem.SubItems(intColIdx - 1) = strValue
    End If
    
End Sub
'----------------------------------------------------------------------------------------------------------
'関数:列名からListViewの列Indexを取得する
'----------------------------------------------------------------------------------------------------------
Private Function GetColIdx(ByRef lv As ListView, ByVal strColKey As String) As Integer
    Dim i As Integer
    GetColIdx = -1
    For i = 1 To lv.ColumnHeaders.Count
        If lv.ColumnHeaders(i).Key = strColKey Then
            GetColIdx = i
            Exit Function
        End If
    Next
End Function
*****************************


フォルダ監視バッチ

特定のフォルダを監視しておいて、特定のファイルが作成されたら別の処理を実行するバッチを作成してみた。
用途としては、OCR処理をするにあたって、特定の共通フォルダを監視しておいて、特定のファイルが作成されたらOCRジョブを実行する。
もちろんOCR以外にも特定のファイルがおかれたら別処理を実行するような仕組みもできる。

HTAアプリケーションで作ろうかとも思ったけどサポートがいつまで続くかわからないし、たいして画面に表示することもないので、いろいろ考えた結果、バッチで十分じゃないのかなぁと。


<処理例>
 ・「CheckFolder.txt」に監視したいフォルダ名を複数行入力しておく
 ・監視バッチが5秒おきに実行し、「CheckFolder.txt」を読み込んで1行ずつ読み込む
   ・指定されたフォルダに「Job.txt」が作成されているかチェックする
   ・Job.txtが作成されていたら、ソフトを起動するコマンドを実行する
    処理後にフォルダ名を変更するなどの処理が必要なら必要に応じてVBSを実行する
    VBSにも引数を渡すことができる
 ・最初の処理に戻る

◆フォルダを監視するバッチ
-------- CheckFolder.txtの内容 ------

C:\Users\SampleUser\Desktop\Yosiki1
C:\Users\SampleUser\Desktop\Yosiki2

----------------------------------------

-------- バッチの内容 ------
@echo off
:loop

rem ReadFolderを開く
echo 処理を終了する場合はCtrl+Cを押下してください。
echo --- 処理実行 ---

for /f %%v in (CheckFolder.txt) do (
echo [%%v]をチェックします...
if exist %%v\Job.txt (
echo VBSを実行する
) else (
echo Job.txtが存在しません
)
)

rem 5秒待ちます
timeout 5

rem コマンドプロンプトの内容をクリア
cls

goto loop
------------------------------

PowerShellでEdgeを自動化(インストール不要。参考:郵便追跡サービス自動操作)

1.経緯について  RPAのソフトをインストールできないので、これまでVBSでCreateObjectでブラウザの自動操作をすることがたまにあった。 ※いざというときの手札として持っているだけで安心感が段違い  見た目上IEがインストールされていなくても、CreateObject...