Excel VBA質問箱 IV

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

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


13447 / 13644 ツリー ←次へ | 前へ→

【5367】指定のフォルダにアクセスしてくれません。 mypapa 03/5/8(木) 15:28 質問
【5374】Re:指定のフォルダにアクセスしてくれません... りん 03/5/9(金) 5:37 回答

【5367】指定のフォルダにアクセスしてくれません。
質問  mypapa  - 03/5/8(木) 15:28 -

引用なし
パスワード
   こんにちは。教えてください。

下記のような流れでVBAを作成したところ、
xls形式でダイアログを指定する際に指定のフォルダに
アクセスしてくれません。記述がおかしいのでしょうか。

それとエクセル自体を閉じるにはどのようなコードを
記述したらよいのでしょうか?
 ThisWorkbook.Close
だと、ブックは閉じるのですがエクセルが起動したままなのです。

よろしくお願いします。

'****************************************
'ダイアログ表示(csv形式)

Dim MyFileA As String
MyFileA = "c:\test\bonaplus" & Format(Date, "yyyymmdd")
Sheets("test").Copy
Application.DisplayAlerts = False
'arg2:=6(csvファイル形式)
Application.Dialogs(xlDialogSaveAs).Show arg1:=MyFileA, arg2:=6
ActiveWindow.Close
Application.DisplayAlerts = True


'ダイアログ表示(xls形式)

Sheets("data").Select
Range("A1").Select

Dim MyFileB As String
MyFileB = "c:\test\bonaplus" & Format(Date, "yyyymmdd") Application.DisplayAlerts = False
'arg2:=1(xlsファイル形式)
Application.Dialogs(xlDialogSaveAs).Show arg1:=MyFileB, arg2:=1
'ActiveWindow.Close

Sheets("data").Select
Range("A1").Select

MsgBox "c:\testにファイルが作成されました。"

ThisWorkbook.Close
Application.DisplayAlerts = True

'****************************************


*************マクロの説明始*****************
指定フォルダにcsv形式でダイアログを表示させる
指定フォルダにxls形式でダイアログを表示させる
エクセルを閉じる
*************マクロの説明終*****************

【5374】Re:指定のフォルダにアクセスしてくれませ...
回答  りん E-MAIL  - 03/5/9(金) 5:37 -

引用なし
パスワード
   mypapa さん、おはようございます。

>下記のような流れでVBAを作成したところ、
>xls形式でダイアログを指定する際に指定のフォルダに
>アクセスしてくれません。記述がおかしいのでしょうか。
 アクセスしないの意味がわかりません。
  ・エラーになる
   ・保存できない(読み取り専用?)
   ・フォルダがない
  ・デフォルトにならない
 どんな理由ですか?

>それとエクセル自体を閉じるにはどのようなコードを
>記述したらよいのでしょうか?
 Application.Quitです。

カレントフォルダを指定する例。
最後にApplication.Quitしますので、マクロを書いたらそのブックを保存してから実行しないと消えてしまうので注意。

Sub test()
  Dim MyFolder As String
  Dim MyFileA As String
  '
  MyFolder = "c:\test"
  MyFileA = MyFolder + "\bonaplus" & Format(Date, "yyyymmdd")
  '今日実行した場合、c:\testフォルダに、
  'bonaplus20030509.csvとbonaplus20030509.xlsができる...でいいのでしょうか?
  'フォルダが無い場合は作成(1階層限定の場合はMkDirでいいです)
  If Dir(MyFileA, vbDirectory) = "" Then
   '2階層以上を指定しても大丈夫なように
   ForceDirectories MyFolder
  End If
  'カレントフォルダ(ダイアログ表示時デフォルトになる)を変更
  ChDrive MyFolder: ChDir MyFolder
  '
  ActiveWorkbook.Worksheets("test").Copy
  Application.DisplayAlerts = False
  'arg2:=6(csvファイル形式)
  Application.Dialogs(xlDialogSaveAs).Show arg1:=MyFileA, arg2:=6
  ActiveWorkbook.Close
  Application.DisplayAlerts = True
  'ダイアログ表示(xls形式)
  'AとBは同じフォルダのようなので統合
  '
  ChDrive MyFolder: ChDir MyFolder
  '
  ActiveWorkbook.Worksheets("data").Select
  ActiveSheet.Range("A1").Select
  Application.DisplayAlerts = False
  'arg2:=1(xlsファイル形式)
  Application.Dialogs(xlDialogSaveAs).Show arg1:=MyFileA, arg2:=1
  Application.DisplayAlerts = True
  MsgBox "c:\testにファイルが作成されました。"
  '
  ThisWorkbook.Saved = True
  Application.Quit
End Sub
'///子フォルダ連続作成↓
Sub ForceDirectories(ByVal Tpath As String)
  '子フォルダを作る C:\a\b\c\d\e というのをdが無い状態でも順次作成
  If Right(Tpath, 1) <> "\" Then Tpath = Tpath + "\"
  Dim pd(20) As Integer
  s1% = 1
  Do
   md% = InStr(s1%, Tpath, "\")
   If md% = 0 Then Exit Do
   CC% = CC% + 1: pd(CC%) = md%: s1% = md% + 1
  Loop
  For NN% = 1 To CC%
   Pdat$ = Left(Tpath, pd(NN%))
   If Dir(Pdat$, vbDirectory) = "" Then MkDir Pdat$
  Next
End Sub

こんな感じです。
 アクセスできない理由がわからないので、フォルダを作成しカレントを変更する方向で考えました。
 違ってたらすみません。

 あと、ファイル名を指定して、フォルダを指定してあるのに、ダイアログを出す理由がわからないのですけど。
 それから、ダイアログでキャンセルをクリックすると、保存されずに終わるのですが、その部分の分岐がついていないので正常終了(2つとも保存)できたように見えますよ。

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