Excel VBA質問箱 IV

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

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


67147 / 76738 ←次へ | 前へ→

【14150】FDのフォルダーとファイルについて
質問  YN61  - 04/5/21(金) 21:18 -

引用なし
パスワード
   USB(ドライブ文字Uに設定しています)のフォルダにあるブックをFDに転送したく思っています。FDの中に「平安」というフォルダが無い場合は、「フォルダーがなく、フォルダを作成する」メッセージをだすこと・・・これは出来ましたが、FDのフォルダーのなかにファイルがある場合のメッセ−を出すことが出来ません。現在『コメント』にとどめていますが、どこが問題なのでしょうか、教えてください。

コードは次の通です。

Sub USBからFDにフォームコピーし最終行データをフォームの最上行に貼付け()

  Dim i As Long
  Dim j As Long
  j = Range("B65536").End(xlUp).Row

  Filename = Dir("A:\平安", vbDirectory)
  If Filename = "" Then
    MsgBox "FDに「平安」のフォルダがありません" & _
    Chr(10) & "「フォルダを作成してください」"
   Exit Sub
  End If
  
 For i = 6 To j
  
'  Filename = "A:\平安\" & Cells(i, 2)・・・この部分のコードが分かりません
'  If Filename <> "" Then
'    MsgBox "「ファイルは既にあります」"
'    Exit Sub
'  End If
  

  Workbooks.Open Filename:="U:\平安\" & Cells(i, 2)  
    Range("B65536").End(xlUp).Select
    Range(Selection, Selection.End(xlToRight)).Select
  Selection.Copy
    Range("B3").Select
  ActiveSheet.Paste
  
  Range("B2").CurrentRegion.Select
  列数 = Selection.Columns.Count
  行数 = Selection.Rows.Count

  Selection.Offset(2, 0).Select
  Selection.Resize(行数 - 1).Select
  Selection.ClearContents
  Range("A1").Select
  
  ActiveWorkbook.SaveAs Filename:="A:\平安\" &
  ActiveWorkbook.Name  '& ".xls"
  Workbooks("WorkOriginal").Activate
  
 Next

End Sub
 
よろしくお願いします

0 hits

【14150】FDのフォルダーとファイルについて YN61 04/5/21(金) 21:18 質問
【14157】Re:FDのフォルダーとファイルについて ryo 04/5/22(土) 12:11 回答
【14187】Re:FDのフォルダーとファイルについて YN61 04/5/22(土) 17:59 質問
【14258】Re:FDのフォルダーとファイルについて YN61 04/5/24(月) 19:32 お礼

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