[[20241212235705]] 『SharePoint上のファイルをダウンロードする処理で』(ぴの) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『SharePoint上のファイルをダウンロードする処理で、ファイルを開いていた場合に出るエラーダイアログの回避方法』(ぴの)

お世話になってます。

VBAでSharePoint上のExcelブックをダウンロードする処理を作成しています。

つまづいているのが、SharePoint上のダウンロード対象ファイルが開かれていた場合に、
『〜.xlsxは他のアプリケーションで開かれています。ファイルを閉じてもう一度お試しください』
というエラーダイアログが表示されてしまう点です。
パワーオートメイトを使用してマクロを動かしたいので、
この表示を回避したいです。

回避方法としては、開いていたらエラーの旨メール送って終了する、
または、強制的にダウンロードする
が出来たらいいなと思っています。
このようなロジックをVBA上で組む方法はないでしょうか?

ちなみに…On error gotoや
Application.DisplayAlerts = Falseを入れてみましたが、
非表示にすることができませんでした。

< 使用 Excel:Microsoft365、使用 OS:Windows11 >


ダウンロードさせるコード部分を見せてもらわないと回答しづらいと思います。
あとPowerAutomateからはマクロを実行できないです。
(Power Automate Desktopは可能)

https://learn.microsoft.com/ja-jp/office/dev/scripts/develop/macros-power-automate
(abec) 2024/12/13(金) 08:00:02


説明不足で大変失礼いたしました。

下記の通り、コードを作成しました。
概要:Sharepoint上のファイルをダウンロードし、指定のローカルフォルダへ格納。
   ※前提:DL元・DL先は別のパラメータファイルから変数取得設定。
   ※例外処理:?@ローカルに同名ファイルがあったら削除してから保存。
         ?Aマクロ実行時エラーの場合…エラーメールを送信して終了。
           ※エラーメールアドレス→パラメータファイルから変数取得。

通常の場合は、下記コードで正常処理できるのですが、
ダウンロード対象ファイルを開いていた場合に、「『〜.xlsxは他のアプリケーションで開かれています。ファイルを閉じてもう一度お試しください』のエラーダイアログが表示されてしまい、マクロが止まってしまいます。
ここを、エラーに倒すでも強制処理するでもいいので、止まらないようにVBA上で処理作成したいです。

※Sharepoint上のダウンロード対象ファイルのパスは、対象ファイルを開いた際にファイルタブ→情報→パスのコピーで取得できる「〜Web1」というURLにて設定しています。

Sub Sharepointファイルをダウンロード()

On Error GoTo myError

Dim DL元, DL先 As String

    Workbooks.Open Filename:="I:\SHARE\FULLACCESS\RPA\A001\作業ファイル.xlsx"
    Sheets("RPA").Select
    DL元 = Range("B13").Value 'SharepointのURL(ファイルを開き、パスのコピーで取得)
    DL先 = Range("B14").Value

    'Excel.Applicationオブジェクトを作成:
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")

    'SharePointからファイルをダウンロード:
    xlApp.Workbooks.Open (DL元) '開いてるとダウンロードできない

    '保存先に同名ファイルがあったら削除
    If Dir(DL先) <> "" Then
        Kill DL先
    End If

    'ファイルをローカルに保存:
    xlApp.ActiveWorkbook.SaveAs DL先
    xlApp.ActiveWorkbook.Close

Exit Sub

myError:

            Workbooks.Open Filename:="I:\SHARE\FULLACCESS\RPA\A001作業ファイル.xlsx"
            Sheets("メール").Select
            Set myOLApp = CreateObject("Outlook.Application")
            Set myDATA = myOLApp.CreateItem(olMailItem)

                '宛先
                myDATA.To = Range("B2")
                '件名
                myDATA.Subject = "A001_SharePoint_DLマクロエラー"
                '本文
                myDATA.Body = "エラーが発生。処理を中断しました。" & vbCrLf & "エラー内容:" & Err.Description
                '送信
                myDATA.send
                        '変数値クリア
            Set myDATA = Nothing
            Set myOLApp = Nothing

End Sub

また、Power Automateでマクロが実行できない件も、有難うございます。
現在、Power Automate for Desktopで作成しており、問題なく実行できていたので、クラウドでも動くものと考えていましたが…そうなのですね。
ゆくゆくはPower Automateに移行させ、自動実行するつもりなので、ここは別で検討してみます。
情報、大変有難うございます。
(ぴの) 2024/12/13(金) 10:45:32


ダウンロードでなく、ファイルを開いて保存としているんですね。
現在新しいExcelオブジェクトを作成してそこで開いていますが、新しく作らず今のインスタンスで開いて保存はダメなんでしょうか。

また、純粋にダウンロードする方法もあるようです。
こちらの手段も試してみては。
https://office54.net/iot/office365/excel-macro-sharepoint-open
(abec) 2024/12/13(金) 12:46:41


abecさま
大変有難うございます。
ご教示いただいた記事を参考にworkbooks.openに変更したところ、他のユーザーが開いていてもファイルをダウンロードする方法でできました!
Sharepoint上ということで、難しく考えすぎていました。
下記コードにてできました。
改めて、大変ありがとうございました。

Sub Sharepointファイルをダウンロード()

On Error GoTo myError
Dim DL元, DL先 As String

    Workbooks.Open Filename:="I:\SHARE\FULLACCESS\RPA\A001_作業\作業ファイル.xlsx"
    Sheets("RPA").Select
    DL元 = Range("B13").Value 'SharepointのURL(ファイルを開き、パスのコピーで取得)
    DL先 = Range("B14").Value

    'SharePointからファイルをダウンロード:
    Workbooks.Open (DL元) '開いてるとダウンロードできない

    '保存先に同名ファイルがあったら削除
    If Dir(DL先) <> "" Then
        Kill DL先
    End If

    'ファイルをローカルに保存:
    ActiveWorkbook.SaveAs DL先
    ActiveWorkbook.Close

Exit Sub

myError:

            Workbooks.Open Filename:="I:\SHARE\FULLACCESS\RPA\A001作業\作業ファイル.xlsx"
            Sheets("メール").Select
            Set myOLApp = CreateObject("Outlook.Application")
            Set myDATA = myOLApp.CreateItem(olMailItem)

            If Err.Number = 1004 Then 'エラーNOが1004(Sharepointファイルが開かれていることによるエラーだったら)
                '宛先
                myDATA.To = Range("B5")
                '件名
                myDATA.Subject = Range("B6")
                '本文
                myDATA.Body = Range("B7") & vbCrLf & "エラー内容:" & Err.Description
                '送信
                myDATA.send
            Else 'それ以外のエラーの場合
                '宛先
                myDATA.To = Range("B2")
                '件名
                myDATA.Subject = "A001_SharePoint_DLマクロエラー"
                '本文
                myDATA.Body = "エラーが発生。処理を中断しました。" & vbCrLf & "エラー内容:" & Err.Description
                '送信
                myDATA.send
            End If
                        '変数値クリア
            Set myDATA = Nothing
            Set myOLApp = Nothing

End Sub
(ぴの) 2024/12/13(金) 14:18:11


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.