SPOエクセルコピーVBA

Sub SPOExcelFileOperations()
    Dim sourceFilePath As String
    Dim destinationFolderPath As String
    Dim fileName As String
    Dim destinationFilePath As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim i As Integer
    
    ' エラーハンドリングの設定
    On Error GoTo ErrorHandler
    
    ' ①SPOに格納されているExcelファイルのパスを指定
    ' 例：https://yourtenant.sharepoint.com/sites/yoursite/Shared%20Documents/SourceFolder/filename.xlsx
    sourceFilePath = "https://yourtenant.sharepoint.com/sites/yoursite/Shared%20Documents/SourceFolder/filename.xlsx"
    
    ' ②保存先SPOフォルダのパスを指定
    ' 例：https://yourtenant.sharepoint.com/sites/yoursite/Shared%20Documents/DestinationFolder/
    destinationFolderPath = "https://yourtenant.sharepoint.com/sites/yoursite/Shared%20Documents/DestinationFolder/"
    
    ' ファイル名を取得してタイムスタンプを付与
    Dim originalFileName As String
    Dim fileExtension As String
    Dim baseFileName As String
    Dim timeStamp As String
    
    originalFileName = Right(sourceFilePath, Len(sourceFilePath) - InStrRev(sourceFilePath, "/"))
    
    ' 拡張子を分離
    If InStr(originalFileName, ".") > 0 Then
        fileExtension = Right(originalFileName, Len(originalFileName) - InStrRev(originalFileName, ".") + 1)
        baseFileName = Left(originalFileName, InStrRev(originalFileName, ".") - 1)
    Else
        fileExtension = ""
        baseFileName = originalFileName
    End If
    
    ' タイムスタンプを生成（YYYYMMDDHHMMSS形式）
    timeStamp = Format(Now(), "YYYYMMDDHHMMSS")
    
    ' タイムスタンプ付きファイル名を作成
    fileName = baseFileName & "_" & timeStamp & fileExtension
    destinationFilePath = destinationFolderPath & fileName
    
    Debug.Print "処理開始: " & Now()
    Debug.Print "ソースファイル: " & sourceFilePath
    Debug.Print "コピー先: " & destinationFilePath
    
    ' ①SPOに格納されているExcelファイルを開く
    Debug.Print "ファイルを開いています..."
    Set wb = Workbooks.Open(sourceFilePath, ReadOnly:=False)
    Debug.Print "ファイルを開きました: " & wb.Name
    
    ' ②別のSPOのフォルダに保存
    Debug.Print "ファイルをコピー先に保存しています..."
    wb.SaveAs destinationFilePath
    Debug.Print "ファイルを保存しました: " & destinationFilePath
    
    ' 元のファイルを閉じる
    wb.Close SaveChanges:=False
    Set wb = Nothing
    
    ' ③②で保存したファイルを開く
    Debug.Print "保存したファイルを再度開いています..."
    Set wb = Workbooks.Open(destinationFilePath, ReadOnly:=False)
    Debug.Print "保存したファイルを開きました: " & wb.Name
    
    ' ④非表示になっているシートを再表示する
    Debug.Print "非表示シートを再表示しています..."
    For i = 1 To wb.Worksheets.Count
        Set ws = wb.Worksheets(i)
        If ws.Visible = xlSheetHidden Or ws.Visible = xlSheetVeryHidden Then
            ws.Visible = xlSheetVisible
            Debug.Print "シート '" & ws.Name & "' を再表示しました"
        End If
    Next i
    
    ' ⑤上書き保存する
    Debug.Print "ファイルを上書き保存しています..."
    wb.Save
    Debug.Print "上書き保存が完了しました"
    
    ' ファイルを閉じる
    wb.Close SaveChanges:=False
    Set wb = Nothing
    
    Debug.Print "すべての処理が完了しました: " & Now()
    MsgBox "処理が正常に完了しました。", vbInformation, "完了"
    
    Exit Sub
    
ErrorHandler:
    ' エラーが発生した場合の処理
    Debug.Print "エラーが発生しました: " & Err.Description
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical, "エラー"
    
    ' ワークブックが開いている場合は閉じる
    If Not wb Is Nothing Then
        wb.Close SaveChanges:=False
        Set wb = Nothing
    End If
End Sub

' 補助関数：SPOの認証が必要な場合の対応
Sub AuthenticateToSPO()
    ' SharePoint Onlineに認証が必要な場合は、以下のような処理を追加
    ' 多要素認証やアプリパスワードが設定されている場合は、
    ' 事前にExcelでSharePointサイトにアクセスして認証を完了させてください
    
    ' または、以下のようにネットワーク資格情報を設定することも可能
    ' Application.DefaultWebOptions.UserName = "[e-mail]"
    ' Application.DefaultWebOptions.Password = "password"
End Sub

' デバッグ用：現在開いているワークブックの非表示シートを確認
Sub CheckHiddenSheets()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim hiddenSheets As String
    
    Set wb = ActiveWorkbook
    hiddenSheets = ""
    
    For Each ws In wb.Worksheets
        If ws.Visible = xlSheetHidden Then
            hiddenSheets = hiddenSheets & "- " & ws.Name & " (Hidden)" & vbNewLine
        ElseIf ws.Visible = xlSheetVeryHidden Then
            hiddenSheets = hiddenSheets & "- " & ws.Name & " (Very Hidden)" & vbNewLine
        End If
    Next ws
    
    If hiddenSheets = "" Then
        MsgBox "非表示のシートはありません。", vbInformation
    Else
        MsgBox "非表示のシート:" & vbNewLine & hiddenSheets, vbInformation
    End If
End Sub