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
コメント欄