Excel VBA質問箱 IV

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

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


1436 / 13645 ツリー ←次へ | 前へ→

【74476】読み取り専用フォルダが開けないエラー ぺーぺー 13/6/24(月) 8:39 質問[未読]
【74480】Re:読み取り専用フォルダが開けないエラー こたつねこ 13/6/25(火) 21:53 回答[未読]
【74486】Re:読み取り専用フォルダが開けないエラー ぺーぺー 13/6/26(水) 19:36 質問[未読]
【74490】Re:読み取り専用フォルダが開けないエラー こたつねこ 13/6/27(木) 10:35 発言[未読]
【74497】Re:読み取り専用フォルダが開けないエラー ぺーぺー 13/7/2(火) 14:16 質問[未読]
【74499】Re:読み取り専用フォルダが開けないエラー こたつねこ 13/7/3(水) 9:42 回答[未読]
【74500】Re:読み取り専用フォルダが開けないエラー ぺーぺー 13/7/3(水) 13:36 お礼[未読]

【74476】読み取り専用フォルダが開けないエラー
質問  ぺーぺー  - 13/6/24(月) 8:39 -

引用なし
パスワード
   複数のブックに処理を繰り返すマクロを作成途中ですが、
肝心の処理の前にフォルダが開けなくて困っております。

エラー
実行時エラー'1004'
'folder1'にアクセスできません。読み取り専用または暗号化されています。

コード
Sub macro()
Dim folder1 As String
Dim folder2 As String
Dim template As String
Dim f As String
Dim wbT As Workbook
Dim wb As Workbook

folder1 = "C:\Users\tsuruta\Documents\macro\folder1" 'フォルダ1
folder2 = "C:\Users\tsuruta\Documents\macro\folder2" 'フォルダ2
template = "C:\Users\tsuruta\Documents\macro\template.xlsm" 'テンプレートBook
f = Dir(folder1 & "1.xlsm") 'フォルダ1内の最初のBook名

Set wbT = Workbooks.Open(template) 'テンプレートを開く
Set wb = Workbooks.Open(folder1 & f) '生データを開く


End Sub


フォルダのプロパティに読み取り専用の項目があり四角で塗りつぶされているのですが、クリックでチェックを外すことができます。しかし、再度プロパティを開くと戻ってしまっています。
また、よくわかっていませんが、PC内のすべてのフォルダは読み取り専用になっているようです。
また、ネットに書いてあった、コマンドプロンプトにてattrib -rを実行する方法では効果がありませんでした。

さらによくわからないのが、
macroフォルダ内にあるtemplateを開くまでは実行されますが、
次の行のfolder1内のブックを開くところで、folder1にアクセスできずエラーとなることです。macroフォルダもfolder1フォルダも見た目はどちらも読み取り専用です。folder1をstringとしておいている関係でしょうか。

かなり困っておりますのでどなたかアドバイスよろしくお願いします。

【74480】Re:読み取り専用フォルダが開けないエラー
回答  こたつねこ  - 13/6/25(火) 21:53 -

引用なし
パスワード
   ぺーぺーさん、こんばんは
こたつねこと申します。

エラー個所や、実際にぺーぺー さんがやりたい処理のことが書かれていないこと
そして、Excelが使えない環境で検証できない事を先にお断りしておきます。

その上での予想ですが、プログラムミスだと思います。
#自分の思ったとおりに動かない場合は、ほぼプログラムミスだと思ったほうが
#いいと思います。


>folder1 = "C:\Users\tsuruta\Documents\macro\folder1" 'フォルダ1
>folder2 = "C:\Users\tsuruta\Documents\macro\folder2" 'フォルダ2
>template = "C:\Users\tsuruta\Documents\macro\template.xlsm" 'テンプレートBook
>f = Dir(folder1 & "1.xlsm") 'フォルダ1内の最初のBook名
Dir関数の引数にどの様な文字列を指定していると想定していますか?
"C:\Users\tsuruta\Documents\macro\folder1" + "1.xlsm" なので
『C:\Users\tsuruta\Documents\macro\folder11.xlsm』です。
おそらく想定しているものと違うと思います。
そして、当然のごとくそのようなファイルは無いと予想しますので
変数fの値は、長さ0の文字列("")が返ってきます。


>Set wb = Workbooks.Open(folder1 & f) '生データを開く
さて、ここで開こうとしているファイル名は
"C:\Users\tsuruta\Documents\macro\folder1" + 長さ0の文字列("")
ですので
『C:\Users\tsuruta\Documents\macro\folder1』とこうなります。
エクセルでフォルダーをファイルの様に開こうとすると、おそらく

>'folder1'にアクセスできません。読み取り専用または暗号化されています。

このエラーが出ると思いますよ。

【74486】Re:読み取り専用フォルダが開けないエラー
質問  ぺーぺー  - 13/6/26(水) 19:36 -

引用なし
パスワード
   素人の質問に付き合っていただきありがとうございます。
ファイルを開けない件は修正できました。

引き続きご教授いただきたいことがありますがまず目的を整理します。

・目的
folder1に生データのブックがたくさん入っている。ファイル名は昇順。
一方でソルバーを実行するためにテンプレートになるブック、ファイル名はtemplateを用意している。
生データのB列をテンプレートの同じくB列にコピペしたうえでソルバーを実行し、
このブックを生データと同じ名前でfolder2に保存する。
以上の操作を全ファイル分繰り返す。

・今できていないこと
計算後のファイルを生データと同じ名前を付けて保存することができていません。
下にコードを示しますが、エラーが出る行は、

wbT.Close True, folder2 & "\" & strWorkBookName 'テンプレートの結果を元のファイル名でフォルダ2に保存して閉じる

のところです。
ソルバー終了までは動いていることが確認できています。

お手数ですがよろしくお願いします。


Sub macro()
Dim folder1 As String
Dim folder2 As String
Dim template As String
Dim f As String
Dim wbT As Workbook
Dim wb As Workbook
Dim strWorkBookName As String

folder1 = "C:\Users\tsuruta\Documents\macro\folder1" 'フォルダ1
folder2 = "C:\Users\tsuruta\Documents\macro\folder2" 'フォルダ2
template = "C:\Users\tsuruta\Documents\macro\template.xlsm" 'テンプレートBook
f = Dir(folder1 & "\" & "1.xlsx") 'フォルダ1内の最初のBook名
Do While f <> "" 'Book名がある間

Set wbT = Workbooks.Open(template) 'テンプレートを開く
Set wb = Workbooks.Open(folder1 & "\" & "1.xlsx") '生データを開く
wb.Worksheets("Sheet1").Range("B:B").Copy '生データのBookのSheet1のB列の値をコピー
wbT.Worksheets("Sheet1").Range("B:B").PasteSpecial 'コピーした値をテンプレートのSheet1のB列にペースト
strWorkBookName = ActiveWorkbook.Name '生データのファイル名をコピー
wb.Close False '生データを保存せずに閉じる

'以下ソルバー実行
SolverReset
SolverOk SetCell:="$G$5", MaxMinVal:=2, ValueOf:=0, ByChange:="$J$3:$J$6", _
Engine:=1, EngineDesc:="GRG Nonlinear"
Application.DisplayAlerts = False
SolverSolve True
Application.DisplayAlerts = True
'ソルバー終了


wbT.Close True, folder2 & "\" & strWorkBookName 'テンプレートの結果を元のファイル名でフォルダ2に保存して閉じる
f = Dir 'フォルダ1内の次のBook名
Loop '繰り返す


End Sub

【74490】Re:読み取り専用フォルダが開けないエラー
発言  こたつねこ  - 13/6/27(木) 10:35 -

引用なし
パスワード
   ぺーぺー さん、こんにちは

>・今できていないこと
>計算後のファイルを生データと同じ名前を付けて保存することができていません。
>下にコードを示しますが、エラーが出る行は、
>
>wbT.Close True, folder2 & "\" & strWorkBookName 'テンプレートの結果を元のファイル名でフォルダ2に保存して閉じる
>
>のところです。
どのようなエラーメッセージがでていますか
できるだけ詳しくそのメッセージを記載してください。

そのほかにも問題がありそうですが、そこも含めて返信は
夜遅くになりそうです。

【74497】Re:読み取り専用フォルダが開けないエラー
質問  ぺーぺー  - 13/7/2(火) 14:16 -

引用なし
パスワード
   非常に遅くなり申し訳ありません。
エラーメッセージを記載しますのでよろしくお願いします。

>どのようなエラーメッセージがでていますか
>できるだけ詳しくそのメッセージを記載してください。

実行時エラー1004
この拡張子は、選択したファイル形式には使用できません。[ファイル名]ボックスでファイル拡張子を変更するか、[ファイルの種類]ボックスで別のファイル形式を選択してください。

【74499】Re:読み取り専用フォルダが開けないエラー
回答  こたつねこ  - 13/7/3(水) 9:42 -

引用なし
パスワード
   ぺーぺーさん、こんにちは
こんな感じでどうでしょう。
ただし、前回同様Excelを使える環境にありませんので、検証を
行っていない事をお断りしておきます。

Sub macro()
 Dim folder1 As String
 Dim folder2 As String
 Dim template As String
 Dim f As String
 Dim wbT As Workbook
 Dim wb As Workbook
' 使いませんので、削除
' Dim strWorkBookName As String
 
 folder1 = "C:\Users\tsuruta\Documents\macro\folder1" 'フォルダ1
 folder2 = "C:\Users\tsuruta\Documents\macro\folder2" 'フォルダ2
 template = "C:\Users\tsuruta\Documents\macro\template.xlsm" 'テンプレートBook

' f = Dir(folder1 & "\" & "1.xlsx") 'フォルダ1内の最初のBook名
' これでは、『C:\Users\tsuruta\Documents\macro\folder1\1.xlsx』しか
' 処理の対象になりませんので、下記のように変更
 f = Dir(folder1 & "\*.xlsx") 'フォルダ1内のxlsxファイルを取得
 
 Do While f <> "" 'Book名がある間
 
  Set wbT = Workbooks.Open(template) 'テンプレートを開く
   
'  Set wb = Workbooks.Open(folder1 & "\" & "1.xlsx") '生データを開く
'  ここもこのままでは、
' 『C:\Users\tsuruta\Documents\macro\folder1\1.xlsx』しか
'  処理の対象になりませんので、下記のように変更。
'  変数『f』には開く対象のファイル名が取得されていますので
'  それを使用してOpenするBookのFullPathを生成。
  Set wb = Workbooks.Open(folder1 & "\" & f) '生データを開く
   
  wb.Worksheets("Sheet1").Range("B:B").Copy '生データのBookのSheet1のB列の値をコピー
  wbT.Worksheets("Sheet1").Range("B:B").PasteSpecial 'コピーした値をテンプレートのSheet1のB列にペースト
   
'  strWorkBookName = ActiveWorkbook.Name '生データのファイル名をコピー
'  変数fにファイル名が取得ずみです。ここは不要になります。

  wb.Close False '生データを保存せずに閉じる
   
  '以下ソルバー実行
  SolverReset
  SolverOk SetCell:="$G$5", MaxMinVal:=2, ValueOf:=0, ByChange:="$J$3:$J$6", _
  Engine:=1, EngineDesc:="GRG Nonlinear"
  Application.DisplayAlerts = False
  SolverSolve True
  Application.DisplayAlerts = True
  'ソルバー終了
    
'  wbT.Close True, folder2 & "\" & strWorkBookName 'テンプレートの結果を元のファイル名でフォルダ2に保存して閉じる
'  変数fを使用して、Folder2へ同名保存。
  wbT.Close True, folder2 & "\" & f
   
  f = Dir 'フォルダ1内の次のBook名
 Loop '繰り返す
End Sub

【74500】Re:読み取り専用フォルダが開けないエラー
お礼  ぺーぺー  - 13/7/3(水) 13:36 -

引用なし
パスワード
   問題なく実行できました。
ありがとうございました。
一度に100単位のブックを処理していたので非常に助かります。

ただ、いただいたコードでは
保存の際にこれまでと同様に拡張子に関するエラーが出ていたので、
templateの拡張子をxlsm -> xlsxに変更したところ、
問題なく実行できました。
(もともとxlsmである必要はなかった)
fとしてコピーしたファイル形式とtemplateのファイル形式が
異なっていたために起こったエラーでしょうか。

最終的なコードは以下です。
ありがとうございました。

Sub macro()
 Dim folder1 As String
 Dim folder2 As String
 Dim template As String
 Dim f As String
 Dim wbT As Workbook
 Dim wb As Workbook
' 使いませんので、削除
' Dim strWorkBookName As String

 folder1 = "C:\Users\tsuruta\Documents\macro\folder1" 'フォルダ1
 folder2 = "C:\Users\tsuruta\Documents\macro\folder2" 'フォルダ2
 template = "C:\Users\tsuruta\Documents\macro\template.xlsx" 'テンプレートBook

' f = Dir(folder1 & "\" & "1.xlsx") 'フォルダ1内の最初のBook名
' これでは、『C:\Users\tsuruta\Documents\macro\folder1\1.xlsx』しか
' 処理の対象になりませんので、下記のように変更
 f = Dir(folder1 & "\*.xlsx") 'フォルダ1内のxlsxファイルを取得

 Do While f <> "" 'Book名がある間

  Set wbT = Workbooks.Open(template) 'テンプレートを開く
 
'  Set wb = Workbooks.Open(folder1 & "\" & "1.xlsx") '生データを開く
'  ここもこのままでは、
' 『C:\Users\tsuruta\Documents\macro\folder1\1.xlsx』しか
'  処理の対象になりませんので、下記のように変更。
'  変数『f』には開く対象のファイル名が取得されていますので
'  それを使用してOpenするBookのFullPathを生成。
  Set wb = Workbooks.Open(folder1 & "\" & f) '生データを開く
 
  wb.Worksheets("Sheet1").Range("B:B").Copy '生データのBookのSheet1のB列の値をコピー
  wbT.Worksheets("Sheet1").Range("B:B").PasteSpecial 'コピーした値をテンプレートのSheet1のB列にペースト
  Application.CutCopyMode = False 'クリップボード停止(警告回避)
 
'  strWorkBookName = ActiveWorkbook.Name '生データのファイル名をコピー
'  変数fにファイル名が取得ずみです。ここは不要になります。

  wb.Close False '生データを保存せずに閉じる
 
  '以下ソルバー実行
  SolverReset
  SolverOk SetCell:="$G$5", MaxMinVal:=2, ValueOf:=0, ByChange:="$J$3:$J$6", _
  Engine:=1, EngineDesc:="GRG Nonlinear"
  Application.DisplayAlerts = False
  SolverSolve True
  Application.DisplayAlerts = True
  'ソルバー終了
  
'  wbT.Close True, folder2 & "\" & strWorkBookName 'テンプレートの結果を元のファイル名でフォルダ2に保存して閉じる
'  変数fを使用して、Folder2へ同名保存。
  wbT.Close True, folder2 & "\" & f
 
  f = Dir 'フォルダ1内の次のBook名
 Loop '繰り返す
End Sub

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