'支払依頼書サーバーアップロード　→　フォルダの中のファイル、全てをプリントアウト Option Explicit Public pathnameIn, pathnameOut, FileName, CsvName, PG_FileName, VBA_PG_FileName As String '---------------------------------------------------------------- 'プリントしたいファイルのフォルダのパス宣言 Public Sub hensuu_settei() 'Ｃドライブに格納されたデータをサーバーに格納する pathnameIn = "C:\Users\*****\Desktop\支払依頼書" 'ローカルアドレス pathnameOut = "\\192.168.1.11\*****\支払依頼書" 'サーバーアドレス End Sub '---------------------------------------------------------------- 'サーバー上の指定したフォルダにファイル全てを格納 Public Sub All_data_insert() '上記で宣言した変数呼び出し Call hensuu_settei 'すべてのファイルを格納 'フォルダをコピー Dim fso As New FileSystemObject Dim TargetFolder As String Dim DestFolder As String 'コピー元フォルダ TargetFolder = pathnameIn 'コピー先フォルダ（新規に作成） DestFolder = pathnameOut fso.CopyFolder Source:=TargetFolder, Destination:=DestFolder End Sub '---------------------------------------------------------------- 'フォルダの中のファイル全てを削除 Public Sub All_data_delete() '上記で宣言した変数呼び出し Call hensuu_settei 'すべてのファイルを削除 Dim fso As FileSystemObject Set fso = New FileSystemObject Dim fl As Folder Set fl = fso.GetFolder(pathnameOut) ' フォルダを取得 Dim f As File For Each f In fl.Files f.Delete (True) ' ファイルを削除 Next '後始末 Set fso = Nothing End Sub '---------------------------------------------------------------- 'エクセル上に配置したコンボボタン（btn_server_tensou）押下時処理 'サーバーの中のすべてのファイルを削除し、にすべてのファイルを格納 Private Sub btn_server_tensou_Click() 'サーバーの中のすべてのファイルを削除 Call All_data_delete 'サーバーの中にすべてのファイルを格納 Call All_data_insert MsgBox ("RPAでＣドライブに発行されたデータをサーバーに格納 完了") End Sub '---------------------------------------------------------------- 'エクセル上に配置したコンボボタン（btn_print）押下時処理 'フォルダの中のすべてのファイルをプリントする Private Sub btn_print_Click() '上記で宣言した変数呼び出し Call hensuu_settei '変数「FileName」に全てのエクセルName格納 FileName = Dir(pathnameOut & "\" & "*.xlsx") 'アウトプットしたいフォルダにファイルがあるか確認 If Dir(pathnameOut & "\*.xls*") = "" Then 'ない場合、処理を中止します MsgBox ("「支払依頼書」はありません。" & vbCrLf & "①を実行してから、②を実行して下さい" & vbCrLf & vbCrLf & "処理を中止します") Exit For Else 'ある場合処理 '画面のちらつきを停止 Application.ScreenUpdating = True '警告や確認を促すメッセージの表示を、False（表示しない） Application.DisplayAlerts = False 'フォルダの中のファイルをすべて印刷実行 Do Until FileName = "" Workbooks.Open pathnameOut & "\" & FileName Worksheets("Sheet1").PrintOut 'プリント実行 Workbooks(FileName).Close SaveChanges:=False '保存せずに閉じる FileName = Dir Loop '警告や確認を促すメッセージの表示を、True（表示する） Application.DisplayAlerts = True '画面のちらつきを解除 Application.ScreenUpdating = False 'サーバーの中のすべてのファイルを削除 Call All_data_delete MsgBox ("プリント実行 完了") End If End Sub