エクセルVBAについての質問です。
 エクセルのマクロで、Aというファイルを開いて、そのうち必要なワークシートだけを抽出し、新しいブックに移動し、その新しいブックを新しいブックのsheet1のセルC2の文字列をファイル名として保存するようなマクロをくみたいと思っています。
 ファイルを開いて必要なワークシートだけを抽出し、新しいブックに移動するところまではできましたが、新しいブックのセルC2の文字列をファイル名として保存することができません。FNを変数として宣言して、C2の文字列を代入し、FNをファイル名として保存しようとすると、ファイルにFNという名前が付いてしまいます。どうすれば、C2の文字列をファイル名として保存できるのでしょうか。なお、保存するフォルダはc:\変換ファイル\6月です。どなたか教えてください。よろしくお願いします。

このQ&Aに関連する最新のQ&A

A 回答 (2件)

FNを文字列として扱っていませんか?以下でどうでしょう?




Sub 保存()

Dim FN As String
FN = Range("C2")
ActiveWorkbook.SaveAs Filename:="C:\変換ファイル\6月\" & FN & ".xls"
End Sub
    • good
    • 8
この回答へのお礼

見事に、今まで必ずデバックがでていたのが嘘のようにできました。本当にありがとうございました。
 今回はおかげさまでできるようになりましたが、HitomiKuroseさんの回答でちょっと分からない点があるのですがまた質問させていただいてよろしいでしょうか。
 今までの自分のステートメントと比べると&がついている点が違っているのですが、&はどのような意味を持っているのでしょうか。あと、FNには文字列(例えば企業名など)が入るので、文字列として扱っていたのですが、それではまずいのでしょうか。もしよろしければ、ご回答寝返ればと思います。
 今回はありがとうございました。

お礼日時:2001/07/31 22:58

&は素直に連結です。



FNの中身は文字列ですが、FN自身は変数なのに
"C:\変換ファイル\6月\FN.xls"
などと書くとFNと云う文字列として扱われる(""の中は文字列)ので変数としてのFNの中身が反映されません。
回答した方法ですと、FNは""の外にあるので変数として認識され、中身が反映します。
    • good
    • 0
この回答へのお礼

 お礼が遅くなって申し訳ありません。
 "" や&の使い方が全然わかっていなかったようです。大変、勉強になりました。どうもありがとうございました。

お礼日時:2001/08/04 18:12

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qexcelのマクロでrangeの選択がうまくいきません。

excelのマクロでrangeの選択がうまくいきません。
以下のマクロをsheet2に書きました。testcopyは動きますが、testcopy2は動きません。なぜなのでしょうか。どうすればいいのでしょうか。それ以外のマクロの部分との関係から、cellsを使い、数字を使ってrangeの処理をしたいのです。よろしくお願いします。

Sub testcopy()
Worksheets("sheet1").Range("B3:C10").Copy
Worksheets("sheet2").Range("e5").Select
ActiveSheet.Paste
End Sub

Sub testcopy2()
Worksheets("sheet1").Range(Cells(3, 2), Cells(10, 3)).Copy
Worksheets("sheet2").Range("e5").Select
ActiveSheet.Paste
End Sub

Aベストアンサー

>testcopyは動きますが、testcopy2は動きません

testcopyは「動作したり、しなかったりする」が正しい表現です。
  要するに今回testcopyが動いたのは▼たまたま▼ということです。

testcopy2 は当然ながらエラーになります。
何れにしろ、両方ともに問題があるということです。
その問題点は2つあります。

(1)アクティブでないシートのセルはSelect(Activate)できない
(2)複数のシートを扱うときのセルの参照は
   そのセルがどのシートのセルなのか明示する必要がある


これを踏まえて、、、、
---------------
●testcopy●

これが動作するのは
Sheet【2】がアクティブな状態で実行する場合です

Sheet【1】がアクティブな状態で実行すると
  Worksheets("sheet2").Range("e5").Select
ここで、問題点(1)の理由によりエラー。
で、先ずシートを選択、次にセルを選択と2段階にしないといけません。

  Worksheets("sheet2").Select
  ActiveSheet.Range("E5").Select

----------------
●testcopy2●

▼Sheet【1】がアクティブな状態で実行
  testcopyと同じ場所、同じ理由でエラー

▼Sheet【2】がアクティブな状態で実行
  Worksheets("sheet1").Range(Cells(3, 2), Cells(10, 3)).Copy
  ここで、問題点(2)により、エラー。
 
 Cellsの前にシートオブジェクトがないので
 Cells(3, 2), Cells(10, 3)はアクティブなSheet【2】のセルとみなされ
 (★実際はちょと違う場合もありますが今回はそう★)

 Worksheets("sheet1").Range(  ← Sheet【1】
 Cells(3, 2), Cells(10, 3))   ← Sheet【2】

このようにSheet【1】【2】が混在していることになり、エラー
で、Cellsの前にシートを付加してセルがどのシートのセルか明示してやる

Worksheets("sheet1").Range(Worksheets("sheet1").Cells(3, 2), Worksheets("sheet1").Cells(10, 3)).Copy
  
---------------------------------
で、質問者のコードを修正すると
'-------------
Sub testcopy()
 Worksheets("sheet1").Range("B3:C10").Copy
 With Worksheets("sheet2")
   .Select
   .Range("E5").Select
   .Paste
 End With
End Sub
'-------------

Sub testcopy2()
 With Worksheets("sheet1")
   .Range(.Cells(3, 2), .Cells(10, 3)).Copy
 End With
 With Worksheets("sheet2")
   .Select
   .Range("E5").Select
   .Paste
 End With
End Sub
'--------------

●ただ今回のような単純なコピーの場合は
 既出の回答にあるようにSelectなしで書くのがふうつです。
'-----------
Sub testcopy111()
 Worksheets("sheet1")
   .Range("B3:C10").Copy Worksheets("sheet2").Range("E5")
 End With
End Sub
'-----------
Sub testcopy222()
 Worksheets("sheet1")
  .Range(.Cells(3, 2), .Cells(10, 3)).Copy Worksheets("sheet2").Range("E5")
 End With
End Sub
'-----------

今回の件は重要事柄ですので覚えておきましょう。
以上です。
 

>testcopyは動きますが、testcopy2は動きません

testcopyは「動作したり、しなかったりする」が正しい表現です。
  要するに今回testcopyが動いたのは▼たまたま▼ということです。

testcopy2 は当然ながらエラーになります。
何れにしろ、両方ともに問題があるということです。
その問題点は2つあります。

(1)アクティブでないシートのセルはSelect(Activate)できない
(2)複数のシートを扱うときのセルの参照は
   そのセルがどのシートのセルなのか明示する必要がある


これを踏まえて、、、、
-...続きを読む

Q1.xls ファイルがC:\に存在するか判定したい。

1.xls というファイルがC:\に存在するか否かを判定するステートメントを教えて頂きたいのですが。この判定をもとに次の処理をしたいと考えています。

Aベストアンサー

C:\ の直下でよろしければ、
MyFile = Dir("C:\1.xls")
で、
if MyFile = "1.xls" then
  存在する
else
  存在しない
end if

QRange("K" & TR).Formula = で、セルにマクロで式を書きたいのですが

よろしくお願いします。いつもgooの皆さんには大変お世話になっています
エクセルは2013です

わけあって、セルにマクロで式を書いています
例えば TRは行を表す変数ですが
Range("K" & TR).Formula = "=IFERROR(AY" & TR & ","""")" と書いたマクロの結果は
=IFERROR(AY43,"") という式がRange("K" & TR) に書かれます

それでは、いま、マクロで下記のように書いているコード(TRは行を表す変数です)
Range("Z" & i) = Range("Z" & i - 1) - Range("AG" & TR) * 10000 は
Range("Z" & i).Formula = 
で書く場合、=の右側をどう書いたら良いでしょうか

色々とやってみたのですが狙った式になりません

この場合 変数 i を使っているので、もしかしたら、そもそも無理なことでしょうか

うまく説明できていませんがよろしくお願いします

Aベストアンサー

No.1です。申し訳ありません大ボケな回答をしていましました。

要するに↓ってことですよね? また勘違いしていたらスミマセン。

Range("Z" & i).Formula = "=Z" & i - 1 & "-AG" & TR & " * 10000"

Q【エクセル マクロ】読み込んだcsvファイルの名前を別名保存のファイル名に使いたい

こんにちは。
当方マクロ初心者で、教本を片手にマクロを組んでいるレベルです。
宜しければご回答お願いします。

質問はタイトルにあるように、
「読み込んだcsvファイルの名前を別名保存のファイル名に使いたい」
ということです。

マクロ有効のエクセルファイル(abc.xlsm)に、csvファイル(123.csv)を取り込む
※GetOpenFilenameというマクロでcsvファイルを取り込んでいます(マクロボタンを設置)

取り込んだcsvデータで集計等の作業をする

作業が終わったマクロ有効エクセルファイル(abc.xlsm)を「別名をつけて保存」する
※この時、保存ダイアログボックスに読み込んだcsvファイルの名前が自動で付与される(123.xlsm)
ようにしたいです。

なお「別名をつけて保存」はエクセルファイル(abc.xlsm)上にマクロ実行用のボタンを設置して使用する予定です。
(ボタンで実行させるのはエクセルに不慣れな方も使用する為です)

説明が下手でやりたいことがうまく伝わっていないかもしれませんが、、、
よろしくご教授くださいませ。

こんにちは。
当方マクロ初心者で、教本を片手にマクロを組んでいるレベルです。
宜しければご回答お願いします。

質問はタイトルにあるように、
「読み込んだcsvファイルの名前を別名保存のファイル名に使いたい」
ということです。

マクロ有効のエクセルファイル(abc.xlsm)に、csvファイル(123.csv)を取り込む
※GetOpenFilenameというマクロでcsvファイルを取り込んでいます(マクロボタンを設置)

取り込んだcsvデータで集計等の作業をする

作業が終わったマクロ有効エクセルファイル(ab...続きを読む

Aベストアンサー

1. とあるマクロ付きブック (仮に macro.xlsm) がある。 こいつは CSV を何らか処理するためのブックである。
2. とある csv ファイル (仮に 20150101.csv) がある。
3. macro.xlsm から 20150101.csv を開き、CSV に書かれているデータを読み取って macro.xlsm 自体のシート上に何らかの転記処理をする。
4. 処理が終わったら macro.xlsm 自身を別名保存する。 ファイル名は読み込み元の CSV ファイルにならって 20150101.xlsm にしたい。
5. 以後、次の CSV を処理する際も macro.xlsm を使って処理を行っていく。
という感じでしょうか。

CSV ファイルを開く際、CSV ファイルの名前を変数にとっておく。
→ 標準モジュールの public 変数にでも入れておく。
→ "名前を付けて保存" の処理と同じ標準モジュールにあるのなら public じゃなくて private な変数でも良い。
または
CSV ファイルを開く際に CSV ファイルを Workbook オブジェクトとして参照しているのなら、その変数の Name プロパティに格納されている。

以下のような変数に CSV ファイルのファイル名 (パスでも可能) を突っ込むと拡張子なしのファイル名を取得できます。
ex.) hoge.csv やら d:\test\hoge.csv やら \\server\aaa\hoge.csv → "hoge"

Function GetCsvBasename(aCsvFileName As String) As String
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  Dim baseName As String
  baseName = fso.GetBaseName(aCsvFileName)
  
  GetCsvBasename = baseName
End Function


ただし xlsm ファイルを SaveAs で保存する際は FileFormat 引数に "xlOpenXMLWorkbookMacroEnabled" を指定しなくてはなりません。。

ThisWorkbook.SaveAs "csv ファイル名", xlOpenXMLWorkbookMacroEnabled

1. とあるマクロ付きブック (仮に macro.xlsm) がある。 こいつは CSV を何らか処理するためのブックである。
2. とある csv ファイル (仮に 20150101.csv) がある。
3. macro.xlsm から 20150101.csv を開き、CSV に書かれているデータを読み取って macro.xlsm 自体のシート上に何らかの転記処理をする。
4. 処理が終わったら macro.xlsm 自身を別名保存する。 ファイル名は読み込み元の CSV ファイルにならって 20150101.xlsm にしたい。
5. 以後、次の CSV を処理する際も macro.xlsm を使って処理を行っていく...続きを読む

QVBA マクロ実行時エラー’1004RangeクラスのPasteSpecialメソッドが失敗

マクロ実行時に、エラー’1004RangeクラスのPasteSpecialメソッドが失敗と表記され、マクロが実行されません。

マクロの内容は、任意の範囲をコピー、新規book追加し、
新規bookに(1)Paste:=xlPasteValues (2)Paste:=xlPasteColumnWidths (3)Paste:=xlPasteFormats の順に貼り付けし保存するものです。

いろいろ調べては見たのですが、当方初心者の為、わからずじまいです。お手数ではございますが、どなたかご教授願います。
下記にマクロ内容全部記載します。
よろしくお願いします。

*********************************************************
*********************************************************
Sub 日報別ファイルに保存したい1()
Worksheets("日報").Range("A3:AF36").Copy
With Workbooks.Add
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

ApplicationDisplayAlerts = True '同名FILEが存在する場合'
ActiveWorkbook.SaveAs Filename:= _
"c:\日報\" & ActiveSheet.Range("J2") & "年" & ActiveSheet.Range("l2") & "月" & ActiveSheet.Range("n2") & "日_日報.xls" _
, FileFormat:=xlNormal
.Close file


End With

End Sub

マクロ実行時に、エラー’1004RangeクラスのPasteSpecialメソッドが失敗と表記され、マクロが実行されません。

マクロの内容は、任意の範囲をコピー、新規book追加し、
新規bookに(1)Paste:=xlPasteValues (2)Paste:=xlPasteColumnWidths (3)Paste:=xlPasteFormats の順に貼り付けし保存するものです。

いろいろ調べては見たのですが、当方初心者の為、わからずじまいです。お手数ではございますが、どなたかご教授願います。
下記にマクロ内容全部記載します。
よろしくお願いします。

***********...続きを読む

Aベストアンサー

こんにちは。

>結果、「ThisWorkbook」上の下記のマクロを削除すると、正常に動きだしました。
それは、Copy 範囲が、消えてしまうことで、PasteSpecial が利かなくなってしまうからです。

まず、シート名の長いコードは、これだけでよいはずです。

Private Sub Workbook_Activate()
 Select Case StrConv(Trim(ActiveSheet.Name), vbNarrow)
 Case "1" To "30", "日報"
  Application.Calculation = xlCalculationManual
 End Select
End Sub


-------------------------------------------
''もし、そのままでダメでしたら、 ' Application.EnableEvents = False 'イベントの介入を阻止する のところのコメント・ブロック('コードの手前のアポストロフィ)を外して、再度試してみてください。

Sub 日報別ファイルに保存したい2()
Dim myRng As Range
Set myRng = Worksheets("日報").Range("A3:AF36")
 ' Application.EnableEvents = False 'イベントの介入を阻止する

With Workbooks.Add
  myRng.Copy
 .ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  myRng.Copy
 .ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  myRng.Copy
 .ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteFormats, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
  Application.CutCopyMode = False
 
 ApplicationDisplayAlerts = True '**これは、そのままでは必要ないはずです。'
 
 ActiveWorkbook.SaveAs Filename:="c:\日報\" & ActiveSheet.Range("J2") & "年" & _
                 ActiveSheet.Range("l2") & "月" & _
                 ActiveSheet.Range("n2") & "日_日報.xls", _
                 FileFormat:=xlNormal
 .Close file
End With
Set myRng = Nothing
'Application.EnableEvents = True 'イベントマクロの活動を戻す

End Sub

こんにちは。

>結果、「ThisWorkbook」上の下記のマクロを削除すると、正常に動きだしました。
それは、Copy 範囲が、消えてしまうことで、PasteSpecial が利かなくなってしまうからです。

まず、シート名の長いコードは、これだけでよいはずです。

Private Sub Workbook_Activate()
 Select Case StrConv(Trim(ActiveSheet.Name), vbNarrow)
 Case "1" To "30", "日報"
  Application.Calculation = xlCalculationManual
 End Select
End Sub


-----------------------------------------...続きを読む

Qアクティブシート名で新しいブックにコピーして保存

はじめて質問させて頂きます。

エクセル2013にて、100シートのものを、それぞれのシート名(B2でも構わない)で別ブックにコピーし、名前をつけて保存する作業をしています。

現在のVBAでは途中でエラーが起きてしまい、かつ出来ればブックは閉じたいとと思っています。


Sub sheetmove()
Dim i As Integer
For i = Worksheets.Count To 2 Step -1
Worksheets(i).Move
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" _
& ActiveSheet.Range("B2") & ".xls"
ThisWorkbook.Activate
Next i
End Sub

前任者の残したマクロでこれ以上触ってしまうと手に負えなくなると思います。
お詳しい方いらっしゃいましたらご教授いただけましたら幸いです。。

どうぞよろしくお願い致します。

はじめて質問させて頂きます。

エクセル2013にて、100シートのものを、それぞれのシート名(B2でも構わない)で別ブックにコピーし、名前をつけて保存する作業をしています。

現在のVBAでは途中でエラーが起きてしまい、かつ出来ればブックは閉じたいとと思っています。


Sub sheetmove()
Dim i As Integer
For i = Worksheets.Count To 2 Step -1
Worksheets(i).Move
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" _
& ActiveSheet.Range("B2") & ".xls"
ThisWorkbook...続きを読む

Aベストアンサー

シートループさせないのであれば、VBA内の『For i = Worksheets.Count To 2 Step -1』『Next i』を外せばよいのですが
変数指定している部分『Worksheets(i).Move』も関係するため、VBAの構文自体を大幅に変更する必要性があります。

質問者gどのように利用したいのかを具体的にお伝えいただけませんか
よろしくお願いします。

QExcelマクロでRange("A1:A5,C1:C5")をCellsで書きたいのですが

マクロ初心者です。
Excelマクロでグラフを作成するときに、元データを指定する所で、
Source:=Range("A1:A5,C1:C5")とするような場合、
「A1」とかアルファベットでの番地指定ではなく、
Cellsを用いて書きたいのです。

Source:=Range("A1:A5")であれば、
Source:=Range(Cells(1, 1), Cells(5, 1))と書けばいいことは分かるのですが、範囲指定を複数にする場合が分からないのです。

よろしくお願いします。

Aベストアンサー

Unionを使用したらできると思います。

Source:=Union(Range(Cells(1, 1), Cells(5, 1)), Range(Cells(1, 3), Cells(5, 3)))

今Excelがインストールされてないパソコンで作業していないので確認はしていないのですが・・・。

よかったら参考にして下さい

QEXCELのブック名を引数(変数)として設定するには

マクロを保存したブック(シート)にデータをコピーしたいブックのウインドウをActiveにしてセルのコピーをしたいのですが、うまくいきません。下記に例を記載しますのでご教示願います。

1 Dim WBK As Workbook
2 Dim stWBK As String
3 Range("A3").Select 'このシートのA3にブック名があります
4 Selection.Copy
5 stWBK = Clipboard
6 Windows(stWBK)Activate

別のやり方で
stWBK= Range("A3").Select
も試しましたがだめです。

Aベストアンサー

複数のシートやブックを扱う時は、操作対象としているRangeがどのブックのどのシートであるかを明示しておいた方が、間違いが少なくなります。
ブック名、シート名で指定するなら、
 Workbooks("book1.xls").Worksheets("sheet1").Range("○○")
のようになります。(ブックやシート、Rangeなどは変数でも可)

作業中にかならず対象のブックが開いているという前提であれば、
 Windows("ブック名").Activate '/←「.」に注意
で対象のブックをアクティブにできます。
ご質問の例でいえば
 stWBK = ActiveSheet.Range("A3").Value (またはText)
 Windows(stWBK).Activate
で可能ですが、実は、手動での操作と違って、わざわざブックをアクティブにする必要はありません。

セルの値の単純コピーを例にすれば
 wb1.sh1.Range("A3") = wb2.sh2.Range("B5")
などとすることで、そのままコピーが可能です。
(Wb1,sh1などは、ブック、シートを示す変数です)

なお、対象とするブックが開いていない場合は、
 Workbooks.Open "○○~~~"
などで、ブックを開くところから記述する必要があります。

複数のシートやブックを扱う時は、操作対象としているRangeがどのブックのどのシートであるかを明示しておいた方が、間違いが少なくなります。
ブック名、シート名で指定するなら、
 Workbooks("book1.xls").Worksheets("sheet1").Range("○○")
のようになります。(ブックやシート、Rangeなどは変数でも可)

作業中にかならず対象のブックが開いているという前提であれば、
 Windows("ブック名").Activate '/←「.」に注意
で対象のブックをアクティブにできます。
ご質問の例でいえば
 stWBK = Acti...続きを読む

Qエクセルのマクロ(range)について

マクロの作りと理解の方法について教えてください。

今、日報を作り直しています。
以前作成した方は、このように作っていました。


Worksheets("日報").Select
Range("Q7:Q23").Value = Range("U7:U23").Value
Range("S7:S59").Value = Range("V7:V59").Value
Range("A1").Select
MsgBox " 転写を終了しました。"
End Sub


マクロでは複数の行列を指定していますが、1行だけ表すと、
具体的な表とデータの変化の仕方とするとこのようになっています。

M    O    Q     S       U     V
個数 金額  累計個数 金額金額 (=M+Q) (=O+S)
0、   0、   100、   1000、    100、   1000 
1,初期状態

10、  100、  100、   1000、    110、   1100
2,個数を入力すると、計算式を入力してあるUとVの数が変わる

10、  100、   110、   1100、    120、   1200
3,マクロを実行すると、UとVの数がQとSに入力され、計算式を入力してあるUとVの数がさらに変わる。

0、   0、    110、   1100、   110、    1100
4,MとOの数をゼロ(クリア)にすると、計算式を入力してあるUとVの数が変わる。     


なかなか理解できないのは、Range("Q7:Q23").Value = Range("U7:U23").Valueの部分で、
2,の後にマクロを実行すると、U 110、V 1100がQ 100とS 1000に書き込まれることです。
通常の計算式だと=は対象となったセルをそのまま表示していると思うのですがのですが、
マクロに書いてある式だと3,のところでUとVの数をQとSに書き込んであります。
なぜ=なのにマクロでは一方のセルに数を書き込んでいるのでしょうか。
また、QやSをUやVへ書き込んでいないのでしょうか。

どなたか詳しく教えていただけると幸いです。

マクロの作りと理解の方法について教えてください。

今、日報を作り直しています。
以前作成した方は、このように作っていました。


Worksheets("日報").Select
Range("Q7:Q23").Value = Range("U7:U23").Value
Range("S7:S59").Value = Range("V7:V59").Value
Range("A1").Select
MsgBox " 転写を終了しました。"
End Sub


マクロでは複数の行列を指定していますが、1行だけ表すと、
具体的な表とデータの変化の仕方とするとこのようになっています。

M    O    Q     S...続きを読む

Aベストアンサー

プログラミング言語では、一般的に、
「=」は、右辺から左辺への「代入」
を意味します。

マクロ = Visual Basic = プログラミング言語
なので、Excelにおける「=」とは少し意味合いが違っています。

Qファイルを探すプログラムで c:\のみ動かない

ファイルを探すプログラムをネット頂き テストしたのですが
c:\ のみ 動かず c:\*** は そのフォルダーから下を探します
e:\ は 全てのフォルダーを探します。
WIN8 ですが どこで間違ってるのでしょうか?
よろしくどうぞ

Option Explicit
Private g_dteDate As Date
Private g_strEXT As String

'参照設定 M-Scripting.Runtime

Cells(1, 2).Value に 探すアドレス 記載 c:\  e:\  c:\*** など

Sub Sample_FileSearch2()

  Dim vntF As Variant
Dim objFSO As FileSystemObject
Dim dteDate As Date
Dim GYO As Long
Dim cntFound As Long

Set objFSO = New FileSystemObject ' FSO
Rows("5:65536").ClearContents
GYO = 4
’ g_dteDate = DateAdd("m", Cells(3, 2).Value * -1, Date) 更新 不要
g_strEXT = UCase(Trim(Cells(2, 2).Value))

' ルートフォルダから探索開始
Call Sample_FileSearch2_SUB(objFSO, _
objFSO.GetFolder(Trim(Cells(1, 2).Value)), GYO, cntFound)
Set objFSO = Nothing
' 処理結果の表示
If cntFound = 0 Then
MsgBox "見つかりません"
Else
MsgBox cntFound & "個見つかりました"
End If
End Sub

'''*******************************************************************************
''' ファイル探索処理(再帰動作)
'''*******************************************************************************
Private Sub Sample_FileSearch2_SUB(objFSO As FileSystemObject, _
ByVal objFolder As Folder, _
GYO As Long, cntFound As Long)
Dim objFolder2 As Folder
Dim objFile As File

' サブフォルダの探索
For Each objFolder2 In objFolder.SubFolders
' サブフォルダ個々の探索(再帰動作)
Call Sample_FileSearch2_SUB(objFSO, objFolder2, GYO, cntFound)

Next objFolder2

' このフォルダ内のファイルの探索
For Each objFile In objFolder.Files
' ここから条件判断
With objFile
If (UCase(objFSO.GetBaseName(.Path)) = g_strEXT) Then

GYO = GYO + 1
Cells(GYO, 1).Value = .Name
Cells(GYO, 2).Value = .DateLastModified
Cells(GYO, 3).Value = _
Left(.Path, Len(.Path) - Len(.Name) - 1)
cntFound = cntFound + 1
End If
End With
Next objFile

End Sub

ファイルを探すプログラムをネット頂き テストしたのですが
c:\ のみ 動かず c:\*** は そのフォルダーから下を探します
e:\ は 全てのフォルダーを探します。
WIN8 ですが どこで間違ってるのでしょうか?
よろしくどうぞ

Option Explicit
Private g_dteDate As Date
Private g_strEXT As String

'参照設定 M-Scripting.Runtime

Cells(1, 2).Value に 探すアドレス 記載 c:\  e:\  c:\*** など

Sub Sample_FileSearch2()

  Dim vntF As Variant
Dim objFSO As FileSystemObject
...続きを読む

Aベストアンサー

該当フォルダの参照権を持つアカウントの
ユーザとパスワードが分かっていれば可能です。
特定の利用者にしか権限を与えないフォルダに
システム情報を記録して、一般ユーザから保護
するという仕組みはよく見られる手法です。

LogonUserで権限ユーザのトーケンを取得し、
ImpersonateLoggedOnUseで偽装します。偽装中は
フォルダを参照できます。
その後、RevertToSelfで偽装を終わり、処理後、
CloseHandleでトーケンを閉じます。
以下、サンプルです。

Const LOGON32_LOGON_INTERACTIVE As Long = 2
Const LOGON32_PROVIDER_DEFAULT As Long = 0
Declare Function LogonUser Lib "Advapi32" Alias "LogonUserA" _
    (ByVal ユーザ As String, _
     ByVal ドメイン As String, _
     ByVal パスワード As String, _
     ByVal タイプ As Long, _
     ByVal プロバイダ As Long, _
     ByRef トーケン As Long) As Long
Declare Function ImpersonateLoggedOnUser Lib "Advapi32" _
    (ByVal トーケン As Long) As Long
Declare Function RevertToSelf Lib "Advapi32" () As Long
Declare Function CloseHandle Lib "kernel32" _
    (ByVal ハンドル As Long) As Long

Sub サンプル()
Dim トーケン As Long
Dim 処理結果 As Long

'★トーケン取得
処理結果 = LogonUser("uuuu", ".", "pppp" _
         , LOGON32_LOGON_INTERACTIVE _
         , LOGON32_PROVIDER_DEFAULT _
         , トーケン)
If 処理結果 = 0 Then
    MsgBox "ログオンできない"
    Exit Sub
End If
'★偽装開始
ImpersonateLoggedOnUser トーケン
'==
'= ここで該当フォルダの処理を行う
'==
'★偽装終了
RevertToSelf
'★トーケン解放
CloseHandle トーケン
End Sub

※上記はローカルアカウントのuuuu/ppppの例です。

但し、フォルダ毎に権限者が誰か調べたりする
必要があります。尚、権限が設定されていないと、
Administratorでも何も出来ません。
これも調べる方法、破る方法はあるんですが、さすがに
セキュリティに関することなので、一般公開できません。

ここまでするよりはエラーハンドリングで逃げたほうが
マシかも知れませんね。

該当フォルダの参照権を持つアカウントの
ユーザとパスワードが分かっていれば可能です。
特定の利用者にしか権限を与えないフォルダに
システム情報を記録して、一般ユーザから保護
するという仕組みはよく見られる手法です。

LogonUserで権限ユーザのトーケンを取得し、
ImpersonateLoggedOnUseで偽装します。偽装中は
フォルダを参照できます。
その後、RevertToSelfで偽装を終わり、処理後、
CloseHandleでトーケンを閉じます。
以下、サンプルです。

Const LOGON32_LOGON_INTERACTIVE As Long = 2
Const LO...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報