ファイル名変更してコピー

解決済

質問者：kenta1005
質問日時：2001/11/22 15:40
回答数：2件

エクセル２０００で次のような処理が出来ますでしょうか。
まず前提として、シート1のＡ列にフォルダＡの中の001.jpg～100.jpgと言う画像
がリンク付けてあります。（Ａ1は001.jpgに～Ａ100は100.jpgに）。
そこで、シート1のＢ列にB1からB***まで数字をガンガン打ち込んでいきます。
打ち込み終わりで、実行すると例えばＢ１が30だとすると030.jpgを
1-030-001.jpg（　（１から連番）－（画像番号）－（検索された回数）.jpg　）
と言うふうにしてフォルダＢにコピーしたいのですが・・。
こんな事出来ますでしょうか？

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (2件)

ベストアンサー優先
最新から表示
回答順に表示

No.1ベストアンサー

回答者： nishi6
回答日時：2001/11/23 01:09

こんな感じでしょうか。

質問の通りにファイルをコピーするはずです。(Excel2000)

コピー先ファイル名の『1から連番』は1～数桁になり、ソートなどには不向きかもしれません。
　DesFile = DesFolder & "\" & (rwCot + 1) &・・・・を（質問のまま）
　DesFile = DesFolder & "\" & RIGHT("0000" & (rwCot + 1), 4) &・・・にすれば連番が４桁固定になります。

フォルダＡ、Ｂは指定してください。

シートのコードウインドウに貼り付けます。
↓
Dim schNum() As Integer '検索された回数

Sub HyperFileCopy()
　　Const SrcFolder = "A:\FolderA" 'コピー元のフォルダ *** 指定する ***
　　Const DesFolder = "A:\FolderB" 'コピー先のフォルダ *** 指定する ***

　　Const jpgNum = 100 'jpgファイルの個数
　　ReDim schNum(jpgNum) As Integer '検索された回数
　　Dim rwCot As Integer 'カウンタ(連番)

　　Dim inpNo As Integer '入力した数値
　　Dim SrcFile As String 'コピー元のファイル名
　　Dim DesFile As String 'コピー先のファイル名

　　While Range("B1").Offset(rwCot, 0) <> "" 'B列を空白セルになるまで読み込む
　　　　inpNo = Range("B1").Offset(rwCot, 0).Value

　　　　'コピー元のファイル名
　　　　SrcFile = SrcFolder & "\" & Range("A" & inpNo).Value
　　　　'コピー先のファイル名
　　　　schNum(inpNo) = schNum(inpNo) + 1 '検索された回数を増やす
　　　　DesFile = DesFolder & "\" & (rwCot + 1) & "-" & _
　　　　　　　　　Right("000" & inpNo, 3) & "-" & _
　　　　　　　　　Right("000" & schNum(inpNo), 3) & ".jpg"

　　　　'ファイルをコピー
　　　　FileCopy SrcFile, DesFile

　　　　rwCot = rwCot + 1 '次の行
　　Wend
End Sub

この回答への補足

nishi6さん、本当にありがとうございます。感謝というか感動です。
おかげさまで出来ました。
一つ質問漏れがありまして、変更したファイル名が　****－***－001.jpg
となった場合（つまり一回目に検索されたファイル）はコピーせず、
そのまま次の処理を続けることは出来ますか？
ファイルをコピーする前に何か一文たせばいいんでしょうか・・？

補足日時：2001/11/23 13:36

通報する