【VBA】アクティブシートを特定のフォルダに保存、アップロードする方法

DBフォルダを作ったはいいものの、残念ながら使われない。。
ということもあるかと思います。
そこで今回は、簡単にファイルをアップロードできるプログラムを紹介します。

【VBA】アクティブシートを特定のフォルダに保存、アップロードする方法

ファイルをアップロードする作業がめんどくさいことで、
データが登録されなくなってしまったら、データベースは本末転倒です。

そこで今回は、アクティブシートをDBフォルダに登録するプログラムを紹介します。

プログラム紹介

プログラムは下記のとおりです。
※ダブルクリックでコピーできます。

'右クリックメニューに追加
Private Sub Auto_Open()
    With CommandBars("Cell").Controls.Add(Before:=1)
        .Caption = "ファイルアップロード(&P)"
        .OnAction = "ファイルアップロード"
    End With
End Sub

'ファイルを落とす際に、右クリックメニューから削除
Private Sub Auto_Close()
CommandBars("Cell").Controls("ファイルアップロード(&P)").Delete
End Sub

Sub ファイルアップロード()

'フォルダの選択
  Dim folderPath As Variant
  With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = "C:\Downloads\"'←イニシャルで表示されるフォルダです。変更してください。
   If .Show = 0 Then
     MsgBox "キャンセルされました。"
     Exit Sub
   End If
   folderPath = .SelectedItems(1)
  End With
 
’ファイル名の選択
HOZONSAKI = folderPath & "\" 
HOZONMEI = Application.InputBox(Prompt:="ファイル名を入力してください。" & vbLf & vbLf, Type:=2, Default:=ActiveSheet.Name)'←初期値はシートネームにしています。
   If HOZONSAKI = False Then
     MsgBox "キャンセルされました。"
     Exit Sub
   End If

'パスの作成
FName = HOZONSAKI & HOZONMEI

'シートの複製
 ActiveSheet.Copy '名前を付け、ファイル形式も決めて特定の場所に保存する。
 ActiveWorkbook.SaveAs _
 Filename:=FName, _
 FileFormat:=xlOpenXMLWorkbook
 
  Application.DisplayAlerts = False
    ActiveWorkbook.Close
  Application.DisplayAlerts = True

End Sub

プログラム紹介

今回紹介するプログラムは、
セル上で、右クリック「ファイルアップロード」を選ぶと、
アクティブシートを指定したフォルダにアップロードできるプログラムになります。

まずは、アップロードを指定するプログラムがここになります。

With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = "C:\Downloads\"'←イニシャルで表示されるフォルダです。変更してください。
   If .Show = 0 Then
     MsgBox "キャンセルされました。"
     Exit Sub
   End If
   folderPath = .SelectedItems(1)
  End With

保存名を決めるのが、下記ファイルです。

’ファイル名の選択
HOZONSAKI = folderPath & "\" 
HOZONMEI = Application.InputBox(Prompt:="ファイル名を入力してください。" & vbLf & vbLf, Type:=2, Default:=ActiveSheet.Name)'←初期値はシートネームにしています。
   If HOZONSAKI = False Then
     MsgBox "キャンセルされました。"
     Exit Sub
   End If

'パスの作成
FName = HOZONSAKI & HOZONMEI

右クリックに追加

このようなプログラムは、右クリックのメニューに追加して、
簡単に使うことができるようにすることが重要です。

下記プログラムは、右クリックにメニューを追加する部分になります。

'右クリックメニューに追加
Private Sub Auto_Open()
    With CommandBars("Cell").Controls.Add(Before:=1)
        .Caption = "ファイルアップロード(&P)"
        .OnAction = "ファイルアップロード"
    End With
End Sub

'ファイルを落とす際に、右クリックメニューから削除
Private Sub Auto_Close()
CommandBars("Cell").Controls("ファイルアップロード(&P)").Delete
End Sub