Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


36 / 12975 ツリー ←次へ | 前へ→

【78852】ファイル移動 ピアニッチ 17/2/11(土) 19:26 質問[未読]

【78857】Re:ファイル移動 ピアニッチ 17/2/11(土) 23:16 発言[未読]
【78858】Re:ファイル移動 β 17/2/11(土) 23:43 発言[未読]
【78860】Re:ファイル移動 ピアニッチ 17/2/12(日) 11:37 お礼[未読]

【78857】Re:ファイル移動
発言  ピアニッチ  - 17/2/11(土) 23:16 -

引用なし
パスワード
   ご教授の程、よろしくお願いします。


Sub 転送()
  Dim myFso As Object
  Dim path1 As String
  Dim path2 As String
  Dim path3 As String
  Dim day As String
  Dim oFilN1 As String
  Dim nFilN1 As String
  Debug.Print
  Set myFso = CreateObject("Scripting.FileSystemObject")
  '移動元ファイルの検索と移動先の指定
  path1 = Range("C12")
  day = InputBox("日付を入力して下さい")
  If day <> Empty Then
    day = CInt(day)
  Else
    Exit Sub
  End If
  oFilN1 = Dir(path1 & "\" & day & "\" & "N1.jpg")
  nFilN1 = Workbooks("起動シート.xls").path
  MsgBox oFilN1

  
  If Not myFso.fileExists(filespec:=oFilN1) Then
    myFso.MoveFile oFilN1, nFilN1
  End If
  Set myFso = Nothing
End Sub
  

【78858】Re:ファイル移動
発言  β  - 17/2/11(土) 23:43 -

引用なし
パスワード
   ▼ピアニッチ さん:

新しいファイル名をどうしたいのかが見えませんので以下では
N1.jpg のままにしてあります。(★ のところ)
ここは、実際のものに変えてください。

移動シート.xls というのは、このマクロブックのことだという前提。

現在の構成は ある親フォルダ配下のサブフォルダを INPUTBOX入力で
指定させ、そのサブフォルダ内の N1.jpg を対象にしていますね。
そうではなく、直接、ファイル選択ダイアログで、N1.jpg を選ばせたほうが
よろしいかとは思いますが、そちらの構成通り、まずフォルダを選ばせます。
ただし、INPUTBOX ではなくフォルダ選択ダイアログを表示して選択させます。

Sub Sample()
  Dim myFso As Object
  Dim path1 As String
  Dim oPath As String
  Dim nPath As String
  Dim oName As String
  Dim nName As String
  Dim oFile As String
  Dim nFile As String
  
  oName = "N1.jpg"
  nName = "N1.jpg"    '★
  
  Set myFso = CreateObject("Scripting.FileSystemObject")
  '元ファイルフォルダの親フォルダ
  path1 = Range("C12").Value
  If Right(path1, 1) <> "\" Then path1 = path1 & "\"
  'フォルダ選択
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = path1
    .Title = "フォルダを選んでください"
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub  'キャンセルボタン
    oPath = .SelectedItems(1)
  End With
  
  nPath = ThisWorkbook.Path
  oFile = oPath & "\" & oName
  nFile = nPath & "\" & nName
  
  '転記元 N1.pdf の存在チェック
  If Not myFso.fileexists(oFile) Then
    MsgBox "ファイルが存在しません"
    Exit Sub
  End If
  '転記先ファイルの削除(念のため)
  If myFso.fileexists(nFile) Then myFso.GetFile(nFile).Delete Force:=True
  'ファイル移動
  myFso.MoveFile oFile, nFile
  
  MsgBox "ファイルを移動しました"
  
End Sub

【78860】Re:ファイル移動
お礼  ピアニッチ  - 17/2/12(日) 11:37 -

引用なし
パスワード
   コード内容を検証しながら、動作確認を致しました。
ファイル選択ではダイアログを使用した方がパス取得に効果的なのですね。

'元ファイルフォルダの親フォルダ
  path1 = Range("C12").Value
課題として親フォルダが複数あるケース(Range("C13").Value)で同様にファイルを移動後、ファイル名を変更するという処理があるのですが、まずは自力で行いたいと思います。

ご回答して頂いた方々、お世話になりました。

36 / 12975 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free