CitronStudio / VBA

0 stars 0 forks source link

作業補助 #1

Open CitronStudio opened 3 months ago

CitronStudio commented 3 months ago

Excel VBAや、パワークエリの覚え書き

CitronStudio commented 3 months ago

Power Queryでこの機能を実装するためには、以下の手順を実行します。

  1. テーブル1をインポート

    • Power Queryエディタで「データ」タブから「テーブル1」をインポートします。
  2. テーブル2をインポート

    • 同様に「テーブル2」もPower Queryエディタにインポートします。
  3. 最新の日付を取得

    • テーブル2の最新の日付を取得するクエリを作成します。
      let
      Source = テーブル2,
      MaxDate = List.Max(Source[日付])  // 日付列の最大値を取得
      in
      MaxDate
  4. 条件付きでデータを追加

    • テーブル1の日付がテーブル2の最新の日付より新しいかどうかを確認し、新しい場合のみデータを追加します。
      let
      Table1 = テーブル1,
      Table2 = テーブル2,
      MaxDate = List.Max(Table2[日付]),  // テーブル2の最新日付を取得
      NewData = Table.SelectRows(Table1, each [日付] > MaxDate),  // 新しいデータを抽出
      CombinedData = Table.Combine({Table2, NewData})  // テーブル2と新しいデータを結合
      in
      CombinedData
  5. 結果を保存

    • このクエリを保存して、「閉じて読み込む」を選択し、Excelに戻します。

この手順により、テーブル1の日付が更新されたときにのみテーブル2に新しい行を追加し、履歴を管理することができます。

具体的な手順を以下に示します:

  1. Excelの「データ」タブで「Power Queryエディタ」を開きます。
  2. 「新しいクエリ」→「テーブル/範囲から」を選択して、テーブル1とテーブル2をインポートします。
  3. クエリエディタで、「高度なエディタ」を開き、上記のMコードを貼り付けます。
  4. クエリを閉じて読み込みます。

これで、テーブル2が自動的に更新されるようになります。

CitronStudio commented 3 months ago

Documents.Open メソッドは、Word ドキュメントを開くために使用されます。このメソッドには、さまざまな引数(制御文字)を指定して、ドキュメントの開き方や処理方法を制御することができます。以下はその引数の一覧です:

  1. FileName: 開きたいファイルの名前(パス)。
  2. ConfirmConversions: True に設定すると、ファイルを開くときに変換確認ダイアログボックスが表示されます。
  3. ReadOnly: True に設定すると、ファイルが読み取り専用として開かれます。
  4. AddToRecentFiles: True に設定すると、ファイルが最近使用したファイルリストに追加されます。
  5. PasswordDocument: ファイルを開くためのパスワードを指定します。
  6. PasswordTemplate: テンプレートを開くためのパスワードを指定します。
  7. Revert: True に設定すると、既に開いているファイルがある場合に再読み込みされます。
  8. WritePasswordDocument: 書き込みパスワードを指定します。
  9. WritePasswordTemplate: テンプレートの書き込みパスワードを指定します。
  10. Format: ファイルの形式を指定します(例えば、wdOpenFormatAuto)。
  11. Encoding: ファイルを開くときのエンコードを指定します。
  12. Visible: True に設定すると、ファイルが開かれたときにウィンドウが表示されます。
  13. OpenAndRepair: True に設定すると、ファイルを修復モードで開きます。
  14. DocumentDirection: 文書の読み書き方向を指定します。
  15. NoEncodingDialog: True に設定すると、エンコーディングダイアログボックスが表示されません。

以下は Documents.Open メソッドの例です:

Dim doc As Document
Set doc = Documents.Open(FileName:="C:\example.docx", ReadOnly:=True, PasswordDocument:="mypassword", Visible:=True)

この例では、example.docx ファイルを読み取り専用として、パスワード「mypassword」で開き、ウィンドウが表示されます。

CitronStudio commented 3 months ago

Documents.Open メソッドの Format 引数には、ファイルを特定の形式で開くための定数を指定することができます。以下に、Format 引数で指定できるすべての値を示します:

  1. wdOpenFormatAuto: 自動検出
  2. wdOpenFormatDocument: 通常のWord文書
  3. wdOpenFormatTemplate: テンプレート文書
  4. wdOpenFormatRTF: リッチテキスト形式(RTF)
  5. wdOpenFormatText: テキスト形式(改行付き)
  6. wdOpenFormatUnicodeText: Unicode テキスト形式
  7. wdOpenFormatEncodedText: 指定されたエンコード形式のテキスト
  8. wdOpenFormatAllWord: すべてのWord文書形式
  9. wdOpenFormatWebPages: Webページ形式(HTML)
  10. wdOpenFormatXML: XML文書
  11. wdOpenFormatXMLDocument: XML文書(.xml)
  12. wdOpenFormatXMLDocumentMacroEnabled: マクロ有効なXML文書(.xml)
  13. wdOpenFormatXMLTemplate: XMLテンプレート(.xmt)
  14. wdOpenFormatXMLTemplateMacroEnabled: マクロ有効なXMLテンプレート(.xmt)
  15. wdOpenFormatDocument97: Word 97-2003文書(.doc)
  16. wdOpenFormatAllWordTemplates: すべてのWordテンプレート形式
  17. wdOpenFormatStrictOpenXMLDocument: 厳密なOpenXML文書(.docx)

これらの定数は、VBAコード内でファイルを開く際に特定の形式を指定するために使用されます。例えば、テキスト形式でファイルを開きたい場合は、以下のように指定します:

Dim doc As Document
Set doc = Documents.Open(FileName:="C:\example.txt", Format:=wdOpenFormatText)

この例では、example.txt ファイルをテキスト形式で開きます。

CitronStudio commented 3 months ago

Excel VBAで指定した機能を実装するためには、以下のようにコードを書くことができます。

  1. ダイアログからローカルのファイル(pdf)を指定する
  2. 指定したファイルのパスを表示する
  3. 指定したファイルがpdfでなければエラーを返す

以下の手順でVBAコードを実装します。

Sub SelectPDFFile()
    Dim fd As FileDialog
    Dim selectedFilePath As String

    ' ダイアログを表示
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "PDFファイルを選択してください"
        .Filters.Clear
        .Filters.Add "PDFファイル", "*.pdf"
        .AllowMultiSelect = False
        If .Show = -1 Then
            ' ファイルが選択された場合
            selectedFilePath = .SelectedItems(1)
            ' 選択されたファイルがPDFかどうかをチェック
            If Right(selectedFilePath, 4) = ".pdf" Then
                MsgBox "選択されたPDFファイルのパス: " & selectedFilePath
            Else
                MsgBox "選択されたファイルはPDFではありません。", vbCritical
            End If
        Else
            MsgBox "ファイルが選択されませんでした。", vbExclamation
        End If
    End With
    Set fd = Nothing
End Sub

解説

  1. FileDialogオブジェクトを使用してファイル選択ダイアログを表示します。
  2. Filtersプロパティを使用して、PDFファイルのみを選択できるようにフィルタを設定します。
  3. ファイルが選択された場合、選択されたファイルのパスを取得し、ファイル拡張子が.pdfかどうかを確認します。
  4. ファイル拡張子が.pdfであれば、ファイルパスを表示し、そうでなければエラーメッセージを表示します。

このコードをVBAエディタにコピーして、適当なモジュールに貼り付けて実行してください。

CitronStudio commented 3 months ago

以下は修正されたExcelVBAのコードです。

Option Explicit
Sub OpenPDFAndSaveAsMHT_Update()
    Dim pdfPath As String
    Dim mhtPath As String
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim startTime As Single
    Dim fd As FileDialog
    Dim selectedFilePath As String
    Dim wb As Workbook
    Dim MHTwb As Workbook
    Dim ws As Worksheet

    ' 画面更新・再計算OFF
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' シートのクリア
    Set wb = ThisWorkbook
    wb.Worksheets(1).Cells.Clear

    ' ダイアログを表示
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "PDFファイルを選択してください"
        .Filters.Clear
        .Filters.Add "PDFファイル", "*.pdf"
        .AllowMultiSelect = False

        If .Show = -1 Then ' ファイルが選択された場合
            selectedFilePath = .SelectedItems(1)

            ' 選択されたファイルがPDFかどうかをチェック
            If Right(selectedFilePath, 4) = ".pdf" Then
                ' PDFのパスを指定します
                pdfPath = selectedFilePath
            Else
                MsgBox "選択されたファイルはPDFではありません。", vbCritical
                Set fd = Nothing
                Application.ScreenUpdating = True
                Application.Calculation = xlCalculationAutomatic
                Application.Calculate
                Exit Sub
            End If
        Else
            MsgBox "ファイルが選択されませんでした。", vbExclamation
            Set fd = Nothing
            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic
            Application.Calculate
            Exit Sub
        End If
    End With

    ' 保存するMHTファイルのパスを指定します
    mhtPath = Replace(pdfPath, ".pdf", ".mht")

    ' Wordアプリケーションを起動します
    On Error Resume Next
    Set wordApp = GetObject(Class:="Word.Application")
    If wordApp Is Nothing Then
        Set wordApp = CreateObject(Class:="Word.Application")
    End If
    On Error GoTo 0

    ' Wordアプリケーションを表示します
    wordApp.Visible = True

    ' PDFをWordで開きます
    Set wordDoc = wordApp.Documents.Open(Filename:=pdfPath, ConfirmConversions:=False, ReadOnly:=False, _
                                         AddToRecentFiles:=False, Format:=wdOpenFormatAuto)

    ' ドキュメントが開き、かつ変換が完了するまで待機(最大20秒)
    startTime = Timer
    Do While wordDoc Is Nothing And wordDoc.ReadOnly And Timer < startTime + 20
        DoEvents
    Loop

    ' 開いたPDFをMHT形式で保存します
    If wordDoc Is Nothing Then
        MsgBox "PDFの読み込みに失敗しました。"
    Else
        wordDoc.SaveAs2 Filename:=mhtPath, FileFormat:=wdFormatWebArchive
    End If

    ' ドキュメントを閉じます
    wordDoc.Close SaveChanges:=False
    ' Wordアプリケーションを閉じます
    wordApp.Quit

    ' MHTファイルをExcelで開きます
    Set MHTwb = Workbooks.Open(Filename:=mhtPath)
    Do While MHTwb Is Nothing
        DoEvents
    Loop

    ' MHTファイルの内容をシートにコピーします
    MHTwb.Activate
    Cells.Select
    Selection.Copy
    wb.Activate
    wb.Worksheets(1).Cells.Select
    ActiveSheet.Paste
    wb.Worksheets(1).Cells(1).Select

    ' MHTファイルを閉じます
    Application.CutCopyMode = False
    MHTwb.Close

    ' 開放
    Set fd = Nothing
    Set wordDoc = Nothing
    Set wordApp = Nothing
    Set MHTwb = Nothing

    ' 画面更新・計算ON
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.Calculate
End Sub

このコードは、PDFファイルをWordで開き、MHT形式で保存し、その内容をExcelシートにコピーするものです。動作確認を行い、問題があれば教えてください。

CitronStudio commented 2 months ago

以下に、指定された動作を実行するExcel VBAコードを提供します。このコードは、フォルダーを指定して、そのフォルダー内にあるすべての.msgファイルを.txtファイルに変換します。

  1. フォルダーの階層を指定する。
  2. フォルダー内の.msgファイルを.txtファイルに変換する。
  3. すべての操作をExcel上で行う。
Option Explicit

' Microsoft Outlook Libraryの参照を追加する必要があります。
' VBAエディタで「ツール」 -> 「参照設定」 -> 「Microsoft Outlook XX.0 Object Library」にチェックを入れる

Sub ConvertMsgToTxt()
    Dim folderPath As String
    Dim msgFile As String
    Dim outFile As String
    Dim outlookApp As Object
    Dim msg As Object
    Dim fso As Object
    Dim file As Object

    ' フォルダーのパスを指定
    folderPath = "C:\Your\Folder\Path\" ' ここを変更してください

    ' Outlookアプリケーションを起動
    Set outlookApp = CreateObject("Outlook.Application")

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

    ' フォルダー内の.msgファイルを検索
    msgFile = Dir(folderPath & "*.msg")

    ' 各.msgファイルを.txtファイルに変換
    Do While msgFile <> ""
        Set msg = outlookApp.CreateItemFromTemplate(folderPath & msgFile)
        outFile = folderPath & Replace(msgFile, ".msg", ".txt")

        ' .msgファイルの内容を.txtファイルとして保存
        Set file = fso.CreateTextFile(outFile, True)
        file.WriteLine "Subject: " & msg.Subject
        file.WriteLine "Body: " & msg.Body
        file.Close

        ' 次の.msgファイルへ
        msgFile = Dir
    Loop

    ' 終了メッセージ
    MsgBox "すべての.msgファイルが.txtファイルに変換されました。", vbInformation
End Sub

注意点

このコードをExcel VBAモジュールにコピーして実行すると、指定したフォルダー内のすべての.msgファイルが.txtファイルに変換されます。

CitronStudio commented 2 months ago

以下に、指定された動作を実行するExcel VBAコードを提供します。このコードは、マクロを実行するとフォルダ選択ダイアログが表示され、選択したフォルダのパスをメッセージボックスで表示します。

Option Explicit

Sub SelectFolderAndShowPath()
    Dim folderPath As String
    Dim folderDialog As FileDialog

    ' フォルダ選択ダイアログを作成
    Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)

    ' ダイアログのタイトルを設定
    folderDialog.Title = "フォルダを選択してください"

    ' ダイアログを表示し、ユーザーがフォルダを選択した場合の処理
    If folderDialog.Show = -1 Then
        folderPath = folderDialog.SelectedItems(1)
        ' 選択したフォルダのパスをメッセージボックスで表示
        MsgBox "選択されたフォルダのパス: " & folderPath, vbInformation
    Else
        MsgBox "フォルダが選択されませんでした。", vbExclamation
    End If
End Sub

注意点

このコードをExcel VBAモジュールにコピーして実行すると、フォルダ選択ダイアログが表示され、選択したフォルダのパスがメッセージボックスに表示されます。

CitronStudio commented 2 months ago

msgFile = Dir(folderPath & "*.msg") が正しく動作しない理由として、いくつかの可能性が考えられます。

  1. フォルダのパスが正しく指定されていない。
  2. フォルダに.msgファイルが存在しない。
  3. パスの末尾にバックスラッシュがない場合、ファイルが見つからないことがある。

以下のコードは、フォルダをダイアログで選択し、選択されたフォルダ内の.msgファイルを.txtファイルに変換する修正バージョンです。

Option Explicit

Sub ConvertMsgToTxt()
    Dim folderPath As String
    Dim msgFile As String
    Dim outFile As String
    Dim outlookApp As Object
    Dim msg As Object
    Dim fso As Object
    Dim file As Object
    Dim folderDialog As FileDialog

    ' フォルダ選択ダイアログを作成
    Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)

    ' ダイアログのタイトルを設定
    folderDialog.Title = "フォルダを選択してください"

    ' ダイアログを表示し、ユーザーがフォルダを選択した場合の処理
    If folderDialog.Show = -1 Then
        folderPath = folderDialog.SelectedItems(1)
        ' 選択されたフォルダのパスをメッセージボックスで表示
        MsgBox "選択されたフォルダのパス: " & folderPath, vbInformation

        ' Outlookアプリケーションを起動
        Set outlookApp = CreateObject("Outlook.Application")

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

        ' フォルダーのパスの末尾にバックスラッシュを追加
        If Right(folderPath, 1) <> "\" Then
            folderPath = folderPath & "\"
        End If

        ' フォルダー内の.msgファイルを検索
        msgFile = Dir(folderPath & "*.msg")

        ' 各.msgファイルを.txtファイルに変換
        Do While msgFile <> ""
            Set msg = outlookApp.CreateItemFromTemplate(folderPath & msgFile)
            outFile = folderPath & Replace(msgFile, ".msg", ".txt")

            ' .msgファイルの内容を.txtファイルとして保存
            Set file = fso.CreateTextFile(outFile, True)
            file.WriteLine "Subject: " & msg.Subject
            file.WriteLine "Body: " & msg.Body
            file.Close

            ' 次の.msgファイルへ
            msgFile = Dir
        Loop

        ' 終了メッセージ
        MsgBox "すべての.msgファイルが.txtファイルに変換されました。", vbInformation
    Else
        MsgBox "フォルダが選択されませんでした。", vbExclamation
    End If
End Sub

改善点

  1. フォルダ選択ダイアログを追加して、ユーザーにフォルダを選択させるようにしました。
  2. フォルダパスの末尾にバックスラッシュを追加して、正しいパス形式を確保しました。
  3. msgFile = Dir(folderPath & "*.msg")の前に、選択されたフォルダのパスをメッセージボックスで表示することで、パスが正しいか確認できます。

この修正版のコードを試してみてください。これで、.msgファイルが正しく見つかるはずです。

CitronStudio commented 2 months ago

MSGファイルに含まれる内容が複雑(例えば、表、画像、その他の形式)な場合、単純なテキスト変換では問題が生じることがあります。MSGファイルの内容を適切に処理するために、以下の点を考慮したコードに変更します:

  1. HTML形式で保存する:MSGファイルの内容をHTML形式で保存し、その内容をテキストファイルに保存する。
  2. エラーハンドリング:エラーが発生した場合でも処理を続行するようにする。

以下のコードは、MSGファイルの内容をHTML形式で保存し、.txtファイルとして保存する改良版です。

Option Explicit

Sub ConvertMsgToTxt()
    Dim folderPath As String
    Dim msgFile As String
    Dim outFile As String
    Dim outlookApp As Object
    Dim msg As Object
    Dim fso As Object
    Dim file As Object
    Dim folderDialog As FileDialog

    ' フォルダ選択ダイアログを作成
    Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)

    ' ダイアログのタイトルを設定
    folderDialog.Title = "フォルダを選択してください"

    ' ダイアログを表示し、ユーザーがフォルダを選択した場合の処理
    If folderDialog.Show = -1 Then
        folderPath = folderDialog.SelectedItems(1)
        ' 選択されたフォルダのパスをメッセージボックスで表示
        MsgBox "選択されたフォルダのパス: " & folderPath, vbInformation

        ' Outlookアプリケーションを起動
        Set outlookApp = CreateObject("Outlook.Application")

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

        ' フォルダーのパスの末尾にバックスラッシュを追加
        If Right(folderPath, 1) <> "\" Then
            folderPath = folderPath & "\"
        End If

        ' フォルダー内の.msgファイルを検索
        msgFile = Dir(folderPath & "*.msg")

        ' 各.msgファイルを.txtファイルに変換
        Do While msgFile <> ""
            On Error Resume Next ' エラーハンドリング
            Set msg = outlookApp.CreateItemFromTemplate(folderPath & msgFile)
            outFile = folderPath & Replace(msgFile, ".msg", ".txt")

            If Not msg Is Nothing Then
                ' .msgファイルの内容を.txtファイルとして保存
                Set file = fso.CreateTextFile(outFile, True)
                file.WriteLine "Subject: " & msg.Subject
                file.WriteLine "Body: " & msg.BodyFormat & msg.HTMLBody ' HTML形式で保存

                ' クリーンアップ
                file.Close
            End If

            ' 次の.msgファイルへ
            msgFile = Dir
            On Error GoTo 0 ' エラーハンドリングを元に戻す
        Loop

        ' 終了メッセージ
        MsgBox "すべての.msgファイルが.txtファイルに変換されました。", vbInformation
    Else
        MsgBox "フォルダが選択されませんでした。", vbExclamation
    End If
End Sub

変更点

  1. HTML形式で保存msg.HTMLBodyを使用してMSGファイルのHTMLコンテンツを取得し、保存します。
  2. エラーハンドリングOn Error Resume Nextを使用してエラーを無視し、次のファイルに進むようにします。

このコードを使用することで、表を含むMSGファイルもエラーなく変換できる可能性が高くなります。

CitronStudio commented 1 week ago

Excel VBAで、アクティブセルが属しているテーブル(ListObject)の名前を取得するには、以下のコードを使用できます。これにより、アクティブセルがテーブル内にある場合、そのテーブル名を取得できます。

Sub GetActiveCellTableName()
    Dim tbl As ListObject
    Dim rng As Range

    On Error Resume Next ' エラー処理

    ' アクティブセルが属するテーブルを取得
    Set tbl = ActiveCell.ListObject

    ' テーブルが見つかったか確認
    If Not tbl Is Nothing Then
        MsgBox "アクティブセルのテーブル名は: " & tbl.Name
    Else
        MsgBox "アクティブセルはテーブル内ではありません。"
    End If
End Sub

このコードでは、ActiveCell.ListObjectを使用して、アクティブセルが含まれているテーブル(ListObject)を取得します。もしアクティブセルがテーブル内にない場合、エラーを無視して「アクティブセルはテーブル内ではありません」と表示します。

このマクロを実行すると、アクティブセルが所属しているテーブル名がメッセージボックスに表示されます。