【Excel】コンピューター名、ユーザー名、ファイルパス名を取得するExcelVBAマクロ

Excel
スポンサーリンク

【Excel】ファイル名の付け方を工夫してExcel起動「UWSC+VBA」半自動マクロを作成する

結果データをコピペするExcelブック:西暦+月+日+場名

  • yyyymmdd場名
    • 20191228阪神
    • 20191228中山

出走馬データをコピペするExcelブック 西暦+月+日+”馬”+場名

  • yyyymmdd場名
    • 20191228阪神
    • 20191228中山

今のところ必要なデータはこの2つなので、名前の付け方はこんな感じで重複しないようにしている。今後増えるとしても、オッズデータぐらいなので、その時は、

  • yyyymmddオ場名

と、なるのかな?まぁ~単複以外はいらんから多分作らんとは思うが…

原紙「yyyymmdd場名・yyyymmdd場名」にExcelVBAマクロが埋め込まれているので、これをコピぺして使うことでプログラムは既にセットされている状態になる。それをマクロとしてボタンに配置しメニュー化しているので、ボタン1つ押せばコピペが始まるシートが完成となる。

コンピューター名、ユーザー名、ファイルパス名を取得するExcelVBAマクロ

コンピューター名を取得する(エクセルマクロ)

Sub GetPcName()
    'WshNetworkオブジェクトを生成
    Dim WshNetworkObj As Object
    Set WshNetworkObj = CreateObject("WScript.Network")
    
    'コンピュータ名を取得
    Dim comname As String
    comname = WshNetworkObj.ComputerName
    '例:コンピューター名をシート名(MST)の セルB4に入れる
    Sheets("MST").Cells(4, 2) = comname    
End Sub

ユーザー名を取得する

Sub GetUserName()
    'WshNetworkオブジェクトを生成
    Dim WshNetworkObj As Object
    Set WshNetworkObj = CreateObject("WScript.Network")
   
    'ユーザー名を取得
    Dim username As String
    username = WshNetworkObj.UserName
    '例:ユーザー名をシート名(MST)の セルB4に入れる
    Sheets("MST").Cells(4, 2) = username          
End Sub

ファイルパス名からファイル名を取得する

Sub GetFilePassName()
    'ThisWorkbook.FullName 呼び出したExcelシートのファイルパス名を取得する
    Dim wk_nm1 As String, wk_nm2 As String
    wk_nm1 = Trim(ThisWorkbook.FullName)
    'ファイルパス名をシート名(MST)の セルB1に入れる
    Sheets("MST").Cells(1, 2) = wk_nm1

    'InStrRev(wk_nm1, "\")) パス名の文字列を後ろから検索し"\"が出たら、前から"\"までの文字数を返す
    'InStr(wk_nm1, "\")) パス名の文字列を前から検索し"\"が出たら 前から"\"までの文字数を返す
    wk_nm2 = Right(wk_nm1, Len(wk_nm1) - InStrRev(wk_nm1, "\"))

    'ファイル名をシート名(MST)の セルB2に入れる
    'ファイル名でつけた西暦4桁をシート名(MST)の セルB3に入れる
    'ファイル名でつけた月2桁をシート名(MST)の セルC3に入れる
    'ファイル名でつけた日2桁をシート名(MST)の セルD3に入れる
    Sheets("MST").Cells(2, 2) = wk_nm2
    Sheets("MST").Cells(3, 2) = Left(wk_nm2, 4)    '''年
    Sheets("MST").Cells(3, 3) = Mid(wk_nm2, 5, 2)  '''月
    Sheets("MST").Cells(3, 4) = Mid(wk_nm2, 7, 2)  '''日
    
    'ファイル名でつけた場名2文字をシート名(MST)の セルE3に入れる
    Dim MyArray As Variant, i As Integer
    MyArray = Array("中山", "東京", "福島", "新潟", "京都", "阪神", "中京", "小倉", "札幌", "函館")
    Sheets("MST").Cells(3, 5) = ""
    For i = 0 To UBound(MyArray)
        If InStrRev(wk_nm2, MyArray(i)) > 0 Then
            Sheets("MST").Cells(3, 5) = MyArray(i)
            Exit For
        End If
    Next
End Sub

私の場合、一人でのシステム運用なのでユーザー名を取得して利用することはない。

コンピュータとファイルパス名をモジュール内で利用している。

ファイル名から日付と場名を取得する(上記ExcelVBAマクロ参照)

  • GetFilePassName
  • ファイル名に意味を持たせる
    • 結果データ:「yyyymmdd+場名」
    • 出走馬データ:「 yyyymmdd+”馬”+場名 」

これで、JRAホームページに入って目的のデータ取得ページまで遷移することが可能になる。

遷移したら、そこからWebの機能として、

  • CTRL+A
  • CTRL+C

このキー操作だけで、そのページのテキスト+画像が取れる(ガードされてなければ)ので、それを【UWSC】で実行し、クリップボード内にコピペされた内容をExcelで取込みデータ加工する。

こんな感じで「Excel+UWSC」スクレイピングは行う。

後は、上の記述をそのまま順番に実行するExcelVBAを書けばよいだけ。最低限の準備は整ったのかな?

編集後記

これでホームページをクリックする材料は揃った。が、まだもう少しVBAで表をいじらないとコピペ状態からデータ投入の表形式に値を持っていけないと思うので、次回もVBAサンプルを紹介する記事になると思われる。

それでは、またね~😎

タイトルとURLをコピーしました