Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows XP全般 : Excel 2000)
ファイルの転送
投稿日時: 17/10/04 21:45:12
投稿者: inzaghi

下記で記したコードを編集すれば実現できそうですが、ファイル名の取得が上手くいかず、実現できません。
お力をお借りできませんでしょうか。
 
目的:ファイルを転送し、転送後、ファイル名を変更したい。
 
情報:
1.移動するファイル名は、
B12に"N4.jpg"
B13に"264.1.jpg"
B14に "MP.jpg"と記載。
※B13のファイル名は、5ケタ目が変化する場合が有る。
264.?.jpg
 
2.転送前のアドレスは,
B12は、C12に記載
B13は、C13に記載
B14は、C14に記載
 
3.転送後のアドレスは、カレントワークブック内
 
4.移動後のファイル名は、
B12はD12,
B13はD13
B14はD14
に記載されている文字列を使用したい。
 
 
 
Option Explicit
 
Sub 転送()
   Dim myFso As Object
   Dim i As Integer
    Dim Path As String
    Dim oPath As String
    Dim nPath As String
    Dim buffer As String
    Dim oName_N As String
    Dim nName_N As String
    Dim oName_2 As String
    Dim nName_2 As String
    Dim oName_M As String
    Dim nName_M As String
    Dim oFile As String
    Dim nFile As String
     
    i = 0
    oName_N = "N4.jpg"
    nName_N = "#18_001.jpg"
    oName_2 = "264.1_1.jpg"
    nName_2 = "#18_002.jpg"
    oName_M = "MP.jpg"
    nName_M = "#18_003.jpg"
    buffer = "\管理"
    
     Set myFso = CreateObject("Scripting.FileSystemObject")
    '元ファイルフォルダの親フォルダ
    For i = 0 To 2
    Path = Cells(i + 12, 3).Value
    If Right(Path, 1) <> "\" Then Path = Path & "\"
    'フォルダ選択
     With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Path
        .Title = "フォルダを選んでください"
        .Show
        If .SelectedItems.count = 0 Then Exit Sub 'キャンセルボタン
        oPath = .SelectedItems(1)
     End With
     nPath = ThisWorkbook.Path
     '元ファイルフォルダと転記元のファイル名の指定
        If i = 0 Then
         oFile = oPath & "\" & oName_N
         nFile = nPath & "\" & nName_N
        ElseIf i = 1 Then
         oFile = oPath & "\" & oName_2
         nFile = nPath & "\" & nName_2
        Else
         oFile = oPath & "\" & oName_M
         nFile = nPath & "\" & nName_M
        End If
         
     '転記元 N4.jpg の存在チェック
    If Not myFso.fileexists(oFile) Then
        MsgBox oFile & "のファイルが存在しません"
        Exit Sub
    End If
    '転記先ファイルの削除(念のため)
     If myFso.fileexists(nFile) Then myFso.GetFile(nFile).Delete Force:=True
    'ファイル移動
    If myFso.Folderexists(nPath) Then
     
     myFso.copyFile oFile, nFile
    End If
     Next
     MsgBox "ファイルを移動しました"
End Sub

回答
投稿日時: 17/10/04 22:00:10
投稿者: simple

こんばんは。
夜分に恐縮ですが、
> ファイル名の取得が上手くいかず
どのようにうまくいかないのか説明ください。
エラーになるのですか?
こうなるはずが、こんなことになってしまう、
という説明をお願いします。

投稿日時: 17/10/04 22:21:38
投稿者: inzaghi

返信ありがとうございます。
 
根本的にコードが組めません。
 
特に情報欄で記したセル13のファイル名が"264.1.jpg"または、5ケタ目だけが異なる時に、
ワイルドカードを使用すれば取得できると思われますが、ファイル名が取得できない状況です。

回答
投稿日時: 17/10/04 22:32:24
投稿者: simple

よくわからないので、具体的に説明してください。
B12,C12,D12に何を書いてあるんですか?
それで、どのようなことを実行したいのですか?

投稿日時: 17/10/04 22:55:31
投稿者: inzaghi

[color=red]恐れ入ります。
 
移動するファイル名は、 下記のセルに記載
B12: N4.jpg
B13: 264.1.jpg
B14: MP.jpg
と記載。
[color=blue]
※B13のファイル名は、5ケタ目が変化する場合が有る。
[/color]
 
目的:上記のファイルを転送し、転送後、ファイル名を変更したい。
 
元ファイルのアドレスは下記のセルに記載されています。
N4.jpgはセルC12
264.1.jpgはセルC13
MP.jpgはセルC14
に記載されています。
 
転送後のアドレスは、
N4.jpgはセルD12
264.1.jpgはセルD13
MP.jpgはセルD14
に記載されている。
 
転送後のファイル名は、
N4.jpgははセルE12,
264.1.jpgはセルE13
MP.jpgはセルE14
に記載されている文字列を使用したい。

投稿日時: 17/10/04 22:58:15
投稿者: inzaghi

コメントの種類を誤ってしまったので追記します。
 
 
移動するファイル名は、 下記のセルに記載
B12: N4.jpg
B13: 264.1.jpg
B14: MP.jpg
と記載。
[color=blue]
※B13のファイル名は、5ケタ目が変化する場合が有る。
[/color]
 
目的:上記のファイルを転送し、転送後、ファイル名を変更したい。
 
元ファイルのアドレスは下記のセルに記載されています。
N4.jpgはセルC12
264.1.jpgはセルC13
MP.jpgはセルC14
に記載されています。
 
転送後のアドレスは、
N4.jpgはセルD12
264.1.jpgはセルD13
MP.jpgはセルD14
に記載されている。
 
転送後のファイル名は、
N4.jpgははセルE12,
264.1.jpgはセルE13
MP.jpgはセルE14
に記載されている文字列を使用したい。
[/quote]

回答
投稿日時: 17/10/04 23:10:12
投稿者: simple

うーん。
3つは結構ですからひとつだけにしませんか?
 
N4.jpgはセルC12
に記載されています。
  
転送後のアドレスは、
N4.jpgはセルD12
に記載されている。
  
転送後のファイル名は、
N4.jpgははセルE12,

 
みんな"N4.jpg"という文字列が入っているんですか?
説明ではなくて、
C12,D12,E12に入っている文字列を端的に書いてください。

投稿日時: 17/10/04 23:34:58
投稿者: inzaghi


>3つは結構ですからひとつだけにしませんか?

 
ひとつでは、目的を達成できないので・・・
 
>みんな"N4.jpg"という文字列が入っているんですか?
 
文字列は、
N4.jpg
264.1.jpg  ←※5桁目は変化します
MP.jpg
 

>C12,D12,E12に入っている文字列を端的に書いてください。

 
C12の文字列は、N4.jpg
 
D12は、C:\Users\n\Desktop\ショートカット   ←※あくまで例です。
 
E12は、#19_000   ←※あくまで例です。
 
 
上記の感じで伝わりますでしょうか?

回答
投稿日時: 17/10/05 07:01:37
投稿者: simple

一つだけの実行にしてということでなく、同様であれば説明はひとつだけでOK、と思いました。
しかし、説明を受けてみると多様な例があるようですから、結果オーライでした。
 
コードに早く入ってほしいという気持ちもあると思いますが、
まずはしっかり内容を確認しましょう。
 
1.D列の"アドレス"というのはどういう意味ですか?
  ファイルのアドレスとは普通言わないのでは?
  フォルダ名ということで良いですか?
  特に、ショートカットとありますが、普通のフォルダ名称ということでよいですね?
   
2.「B13のファイル名は、5ケタ目が変化する場合が有る。」 について。
  5桁目が違う複数のファイルがありますか?
  なければ問題ないですが、複数あるときには、
  転送先のファイル名称は一つに決まるのですか?
 
3.コードではフォルダ選択のダイアログを使っていますが、その目的は?
  シート上の情報だけで、フォルダは転送元も転送先も指定されている、
  と考えていいのですね?
 
4. 「E12は、#19_000   ←※あくまで例です。 」とあります。
  拡張子は無いファイルなんですね。
  あくまで例です、と強調されていますが、
  内容さえ皆さんが理解できれば、
  セルの値を変数に受けたうえで処理しますので、
  例に挙げたケース以外は対応できないなどという事態にはなりません。心配無用です。
 
# 私は自宅でしか回答しませんし、日中はアクセスしない方針です。
# 続きはたぶん他の方からコメントいただけるものと思います。
# たぶん、Dir(フォルダ & ワイルドカード有りのファイル名)で実際のファイル名を取得して
# 前に進めることになるのでしょう。

投稿日時: 17/10/05 22:43:36
投稿者: inzaghi

 
1.D列の"アドレス"というのはどういう意味ですか?
 
フォルダ名です。
ショートカットの表記は、普通のフォルダ名称です。
   
2.「B13のファイル名は、5ケタ目が変化する場合が有る。」 について。
  5桁目が違う複数のファイルがありますか?
 
複数はありません。転送先のファイル名称は、一つに決まります。
 
3.コードではフォルダ選択のダイアログを使っていますが、その目的は?
シート上の情報だけで、フォルダは転送元も転送先も指定されている、
  と考えていいのですね?
 
肝心なことを書き忘れていました。
ダイアログを使用していた理由は、D列のフォルダ名の一つ下の階層には、日付名の
フォルダが無数に作成しています。
現状は、ダイアログから一つ下の階層のフォルダ選択には手動で選択していました。
転送前のデータは、日付名のフォルダ内にあります。
対策として、今後は、インプットボックスで日付名のフォルダ(ex.20171005)を入力し、アクセスできるようにしたい。

 
 
4. 「E12は、#19_000   ←※あくまで例です。 」とあります。
  拡張子は無いファイルなんですね。
 
拡張子は、".jpg"です。
 
 
# 私は自宅でしか回答しませんし、日中はアクセスしない方針です。
 
承知しました。
よろしくお願いします。

回答
投稿日時: 17/10/06 06:57:14
投稿者: simple

B列                 C列            D列                 E列
コピー元ファイル名  〃フォルダ名   コピー先フォルダ名  〃ファイル名
ということなんですか?(順序が不整合ですが)
 
ワイルドカードの関係だけ書きます。
5桁目のみ不定ということなら、
そこは、"264.*.jpg" のようにシートのB列に入力しておき、
例えば以下のようにDir関数を使えばよいでしょう。
 
    For k = 12 To 14
        sfile = Cells(k, "B").Value
        sfolder = Cells(k, "C").Value
        dfolder = Cells(k, "D").Value
        dfile = Cells(k, "E").Value

        sPath = sfolder & "\" & sfile

        ' sfileワイルドカード対応("264.*.jpg" などの入力)
        f = Dir(sPath)   '実際のファイル名が返るはずです。
        sPath = sfolder & "\" & f

        dPath = dfolder & "\" & dfile

        '以下、Copyする命令を書きます。
    Next
それ以外の部分はすでにできあがっているはずですので、組み合わせて下さい。
 
日付も各行毎に何度も指定しているようですが、固定ではないんですか?
違うのならシート上にそういう列を作成しておいて、手で入力しておくほうが良いのでは?
ここはそちらで考えてみて下さい。

投稿日時: 17/10/07 12:05:15
投稿者: inzaghi

ワイルドカードの処理参考になりました。
既存のコードと組み合わせ、満足ゆく結果になりました。
数日間ご多忙の中大変お世話になりました。

回答
投稿日時: 17/10/07 16:14:08
投稿者: WinArrow
投稿者のウェブサイトに移動

>既存のコードと組み合わせ、満足ゆく結果になりました。
  
満足・・・、それはよかったです。
  
 >既存のコードと組合せ
 の部分が引っかかりす。
simpleさんコードを採り入れたとすると
組合わせではなく、全面組み替えになると思います。
 
最初のコードには、ずいぶんと無駄が多く、メンテナンス性が悪く
メンテナンスというよりは、組み換えになる可能性が大きい。
 
今後のメンテナンスに苦労すると思います。
そんなわけで、組み合わせたコードを掲示して添削して貰った方がよいと思いますが、
 如何ですか?
 

投稿日時: 17/10/07 17:52:54
投稿者: inzaghi

ご配慮ありがとうございます。
 
>最初のコードには、ずいぶんと無駄が多く、メンテナンス性が悪く
 メンテナンスというよりは、組み換えになる可能性が大きい。
 
おっしゃる通りです。知識がないゆえ、メンテナンス性を考慮できるほど応用が利きません。
やっつけのコードです。
添削して頂けるなら、知識向上含めて、お願いしたいです。
 
Option Explicit
 
Sub 転送()
   Dim myFso As Object
    Dim k As Integer
    Dim sfile As String
    Dim sfolder As String
    Dim dfile As String
    Dim dfolder As String
    Dim sPath As String
    Dim sPath2 As String
    Dim dPath As String
    Dim f As String
    Dim f2 As String
    Dim temp As String
    Dim day As String
    temp = InputBox("日付を指定してください")
     
    If temp <> Empty Then
        day = CLng(temp)
    Else
        Exit Sub
    End If
    
    Set myFso = CreateObject("Scripting.FileSystemObject")
'ファイル名、フォルダ名
    For k = 15 To 17
        sfile = Cells(k, "B").Value
        sfolder = Cells(k, "C").Value
        dfile = Cells(k, "D").Value
        dfolder = Cells(k, "E").Value
        sPath = sfolder & "\" & day & "\" & sfile
         
        If sfile <> "264" Then ' sfileワイルドカード対応("264*.jpg" の入力)
          f = Dir(sPath & ".jpg")
          Else
            f2 = Dir(sPath & "*.jpg")
        End If
        If sfile <> "264" Then
          sPath = sfolder & "\" & day & "\" & f
          Else
            sPath2 = sfolder & "\" & day & "\" & f2
        End If
        dPath = dfolder & "\" & dfile
         
     '転記元 N1.pdf の存在チェック
    If sfile <> "264" Then
      If Not myFso.fileexists(sPath) Then
          MsgBox sfile & "のファイルが存在しません"
          Exit Sub
      End If
      Else
      If Not myFso.fileexists(sPath2) Then
          MsgBox sfile & "のファイルが存在しません"
          Exit Sub
      End If
    End If
         
    '転記先ファイルの削除(念のため)
     If myFso.fileexists(dPath) Then myFso.GetFile(dPath).Delete Force:=True
    'ファイル移動
    If sfile <> "264" Then
      If myFso.Folderexists(dfolder & "\") Then
         myFso.copyFile sPath, dPath
      End If
    Else
      If myFso.Folderexists(dfolder & "\") Then
        myFso.copyFile sPath2, dPath
      End If
    End If
 
    Next
End Sub

回答
投稿日時: 17/10/07 22:25:49
投稿者: WinArrow
投稿者のウェブサイトに移動

幾つかの問題があります。
 
(1)の問題
> If temp <> Empty Then
> day = CLng(temp)
 
temp変数はデータ型を文字列で定義しています。
そしてINPUTBOX関数で入力していので、受取は文字列になります。
ですから、「キャンセル」を押したと以き、または、何も入力せずに「OK」を押したときは
空白文字列が返ります、(Emptyにはならない)
チェックするならば、
If Temp <> "" Then
だろうね・・・
 
それから、空白文字列だけチェックして大丈夫?
数字以外のチェックはしなくても大丈夫かな?
 
(2)の問題
> temp = InputBox("日付を指定してください")
  この日付は何を意味しているか?オペレータにわかりますか?
  サブフォルダ名なんだから、キチンと伝えなくてはいけないのでは?
  例えば、2017/10/3 なんて入力されたら困りませんか?
 
 
(3)の問題
やたらと
If sFile <> "264" Then
が出てくる。・・・非常に読みにくい。
For k = 12 To 14
    If sFile <> "264" Then
   'やるべきこと全部
    Else
      ' やるべきこと全部
    End If
Next
 
のようにすればスッキリしませんか?
 
(4)の問題
B13セル
このセルの値は誰が入力するのですか?
単純に「264]しかチェックしていませんが、
このセルがB13であるという保証は必要ないんかな?
 
(5)の問題・・・これは問題というより疑問
> '転記元 N1.pdf の存在チェック
これは何ですか?
コメントだから実行には差し支えないが、後で読んだとき、どのように思うかな?
 
 
 
 

投稿日時: 17/10/08 07:38:15
投稿者: inzaghi

(2)(3)(5)はの問いに関して理解したつもりで訂正しました。
 
(1)について
>それから、空白文字列だけチェックして大丈夫?
>数字以外のチェックはしなくても大丈夫かな?
 
数字以外のチェックの仕方を教えて頂けますでしょうか。
EmptyでもExit Subで引っかかるのですが、""に訂正した方が良いでしょうか?
 
(4)について264の文字列は,
B16に入力してあります。
シートに入力されてる文字列は、私が入力します。
基本固定値なので、消したり、変更することはありません。
 
以上を踏まえて、コードを訂正しました。
実は、次のステップとして転送し、ファイル名を変更したファイルを
別のワークブックに貼り付けるコードを作成します。
時間が許す限り、ご指導頂けると幸いです。
まずは、たたき台を作成したいと思います。
 
 
Sub 転送()
   Dim myFso As Object
    Dim k As Integer
    Dim sfile As String
    Dim sfolder As String
    Dim dfile As String
    Dim dfolder As String
    Dim sPath As String
    Dim sPath2 As String
    Dim dPath As String
    Dim f As String
    Dim f2 As String
    Dim temp As String
    Dim day As String
    temp = InputBox("日付は、西暦+月+日の形式で入力して下さい。(入力例:2017年10月06日⇒20171006)")
     
    If temp <> Empty Then
        day = CLng(temp)
    Else
        Exit Sub
    End If
    
    Set myFso = CreateObject("Scripting.FileSystemObject")
'ファイル名、フォルダ名
    For k = 15 To 17
        sfile = Cells(k, "B").Value
        sfolder = Cells(k, "C").Value
        dfile = Cells(k, "D").Value
        dfolder = Cells(k, "E").Value
        sPath = sfolder & "\" & day & "\" & sfile
         
        If sfile <> "264." Then ' sfileワイルドカード対応("264.*jpg" の入力)
          f = Dir(sPath & ".jpg")
          sPath = sfolder & "\" & day & "\" & f
          Else
            f2 = Dir(sPath & "*.jpg")
            sPath2 = sfolder & "\" & day & "\" & f2
        End If
        dPath = dfolder & "\" & dfile
         
    '転記元 jpgファイル の存在チェック
    If sfile <> "264." Then
      If Not myFso.fileexists(sPath) Then
          MsgBox sfile & "のファイルが存在しません"
          Exit Sub
      End If
      Else
      If Not myFso.fileexists(sPath2) Then
          MsgBox sfile & "のファイルが存在しません"
          Exit Sub
      End If
    End If
         
    '転記先ファイルの削除(念のため)
     If myFso.fileexists(dPath) Then myFso.GetFile(dPath).Delete Force:=True
    'ファイル移動
    If sfile <> "264." Then
      If myFso.Folderexists(dfolder & "\") Then
         myFso.copyFile sPath, dPath
      End If
    Else
      If myFso.Folderexists(dfolder & "\") Then
        myFso.copyFile sPath2, dPath
      End If
    End If
 
    Next
End Sub

回答
投稿日時: 17/10/08 08:43:53
投稿者: simple

最初に訂正をしておきます。
"ファイル名が取得できない"というところから出発してしまったので、
FSOのCopyFileもMoveFileもファイル名部分のワイルドカードを受け付けることを
うっかりしていました。
そのように修正してください。
 
B列へはどのような入力をしているのでしょうか。
前回は"264.*.jpg"とシートに入力する前提でした。
話が変わってきているならそのように説明してください。
5桁目が不定ではなかったのですか?
また.jpgは入力しないようにしたのですね?
また、そうしたワールドカード指定は264だけなんですか?
 
私は、シート側にワイルドカードは埋め込んだほうが汎用的だと思います。
場合分けする必要がありません。
仮に場合分けするとしても最初のところだけでしょう。
ファイル存在チェックや転送処理には場合分けは不要です。
(つまり変数f,f2の二つを使う必要はないということです)
 
その他の気づいたところ。
(1)ファイルの移動ですかコピーですか?明確にしたほうがよいでしょう。
   移動ならMoveFileです。
(2)フォルダの存在チェックをするなら、dayも反映したものでチェックすべきですね。
 
以下は内容とは関係ないことですが、一応ご注意申し上げておきます。
こちらに質問中なのに別の掲示板(質問箱)に同じ質問する理由がわかりませんでした。
こちらは質問しにくかったですか?
また投稿する際は、他人が書いたコードを使っていることを明記されたほうが
回答者にとっても有益だと思います。
こうしたコードが書ける人が何を悩んでいるのだろうかと不思議になります。
がんばってください。

回答
投稿日時: 17/10/08 12:47:32
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:

    If temp <> Empty Then
         day = CLng(temp)
     Else
         Exit Sub
     End If

↑の関して
 
一般的には、
If temp = Enpty Then
という使い方はしないでしょう。
そもそも Empty はバリアント型の変数に対して使うものなので
文字列型変数に対する空白文字列を判断する場合は
If temp = "" Then
または
If Len(temp) = 0 Then
が一般的な書き方です。
 
バリアント型の変数の値が何もない(Empty)を判断する場合は
If IsEmpty(temp) Then
と書きます。
 
 
数字チェックは
If IsNumeric(temp) Then
です。
 
蛇足
複写元フォルダを手入力するより(日部分を含めて)
ダイアログを表示して選択して貰う方が、的確&不要なコード記述しなくてよくなります。
コードが完結になります。
 
複写先フォルダの存在チェックをしていますが、
複写先フォルダが無かった場合の処置が見当たらない?
 
 
 

回答
投稿日時: 17/10/08 13:11:11
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
複写先フォルダの存在チェックをしていますが、
 複写先フォルダが無かった場合の処置が見当たらない?

について、
 
複写先ファイル有無をチェックしていますが、
「無」の場合、ファイルがないからといってフォルダがあるとか限りません。

回答
投稿日時: 17/10/08 13:33:29
投稿者: WinArrow
投稿者のウェブサイトに移動

追加情報
 
Excelには、ファイル名を選択するダイアログが用意されています。
GetOpenFienameです。
 
若し、3つのファイルが同じフォルダに入っているならば
↓のようなコードが有効になります。
 
Dim filetoopen, fname
    ChDir "C:\Users\xxxxx\Pictures"
    filetoopen = Application _
        .GetOpenFilename(FileFilter:="Jpeg Files (*.jpg), *.jpg", MultiSelect:=True)
    If IsArray(filetoopen) Then
        For Each fname In filetoopen
            MsgBox "Open " & fname
        Next
    Else
        MsgBox "キャンセル"
    End If

回答
投稿日時: 17/10/08 20:15:48
投稿者: WinArrow
投稿者のウェブサイトに移動

少し気になったので、再再の質問
 
> temp = InputBox("日付は、西暦+月+日の形式で入力して下さい。(入力例:2017年10月06日⇒20171006)")
 
このコードで日付を入力させる目的は?
例えば、指定フォルダの中に日付(yyyymmdd形式)サブフォルダが複数存在することは想定されるが、
その中で、サブフォルダを入力させたいのか?
ということです。
それをPromptに表示しないと、オペレータに伝わらないし、意図しない日付を入力してしまうことになります。
 
入力しか方法がないのか?
 
サブフォルダ名の最大が必要だったら、入力させなくてもVBAで取得可能ですよね?
 
 
 

トピックに返信