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