画像ファイル名抽出マクロが機能しない

前へ 次へ
このQ&Aのポイント
  • 当時に作成されたマクロが動作しなくなりました。
  • ファイル名の抽出に問題が発生しています。
  • 原因を特定し、問題を解決する必要があります。
回答を見る
  • ベストアンサー

画像ファイル名抽出マクロが機能しない

mt2015様 以前 https://okwave.jp/qa/q9432826.html で質問させていただいたものです。 当時に作っていただいた Sub Sample() 　　sPath = "C:\Users\Owner\Downloads\通販素材\tsuhan_jp_5028_2018-02-26\setting_000002016\" 　　nRow = 2 　　sSubFol = Cells(nRow, 1).Text 　　Do While sSubFol <> "" 　　　　nCol = 10 　　　　sFileName = Dir(sPath & sSubFol & "\*.jpg") 　　　　Do While sFileName <> "" 　　　　　　Cells(nRow, nCol) = sFileName 　　　　　　sFileName = Dir() 　　　　　　nCol = nCol + 1 　　　　Loop 　　　　nRow = nRow + 1 　　　　sSubFol = Cells(nRow, 1).Text 　　Loop End Sub のマクロが当時は問題なく動いていたのですが、急にファイル名が抽出されなくなったのですが、どのような原因が考えられますでしょうか？

質問者が選んだベストアンサー

  • ベストアンサー
  • mt2015
  • ベストアンサー率49% (258/524)
回答No.1

・Pathが「C:\Users\Owner\Downloads\通販素材\tsuhan_jp_5028_2018-02-26\setting_000002016」から変わった。 ・違うシートをアクティブにした状態でマクロを実行している。 と、言った辺りが気になります。 マクロを使うならデバッグ方法についても身につけましょう。 1行づつステップ実行して、変数に入った値を確認し、何が想定と違うのかを確認すれば原因も修正方法も解ります。

saya100111
質問者

お礼

助かりましたありがとうございます。

saya100111
質問者

補足

保存しているファイルのフォルダの場所が変わり、マクロのパスを変更いたしました。しかし何も反応しませんでした。 その後ためしにマクロのファイルをサブフォルダの直下に保存し実行したらできたのですが、その方法で良かったのでしょうか？

その他の回答 (1)

  • mt2015
  • ベストアンサー率49% (258/524)
回答No.2

> その後ためしにマクロのファイルをサブフォルダの直下に保存し実行したらできたのですが、その方法で良かったのでしょうか？ そちらの環境が解りませんので何とも言えませんが、「信頼できる場所」以外に保存されたブックのマクロを無効にする設定がされていればありえます。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • 画像ファイル名をパス付きで表示

    Sub Test2() Dim objFSO As Object Dim sPath As String, sSubFol As String, sFileName As String Dim nRow As Long, nCol As Long Set objFSO = CreateObject("Scripting.FileSystemObject") sPath = "C:\Users\Owner\Downloads\base\setting_000002016\" nRow = 2 sSubFol = Cells(nRow, 1).Text Do While sSubFol <> "" nCol = 11 sFileName = Dir(sPath & sSubFol & "\*.jpg") If objFSO.FileExists(sPath & sSubFol & "\" & sSubFol & ".jpg") Then nCol = 12 Else nCol = 11 End If Do While sFileName <> "" If sFileName = sSubFol & ".jpg" Then Cells(nRow, 11) = sFileName Else Cells(nRow, nCol) = sFileName nCol = nCol + 1 End If sFileName = Dir() Loop nRow = nRow + 1 sSubFol = Cells(nRow, 1).Text Loop Set objFSO = Nothing End Sub こちらは商品番号とサブフォルダの名前が一致したらフォルダ内のファイル名を抽出するというマクロですが、これをパス付で表示という動作をするにはどこをいじればよろしいでしょうか？

  • 一致したファイル名を先頭に抽出させる方法

    Sub Sample() sPath = "C:\Users\Owner\Downloads\base\setting_000002016\" nRow = 2 sSubFol = Cells(nRow, 1).Text Do While sSubFol <> "" nCol = 11 sFileName = Dir(sPath & sSubFol & "\*.jpg") Do While sFileName <> "" Cells(nRow, nCol) = sFileName sFileName = Dir() nCol = nCol + 1 Loop nRow = nRow + 1 sSubFol = Cells(nRow, 1).Text Loop End Sub こちらは、指定の商品番号と同じ商品番号の名前になっているサブフォルダ名のファイル名をK列以降に抽出するというvbaでつくられたプログラムです。 実際の例で説明いたします。 商品番号が１２３、サブフォルダ名１２３だとして、 ファイル名が001.jpg,002.jpg.003.jpg,123.jpgという不規則なファイル名があったとします。 上記のプログラムはファイル名の順番問わず K列から順番に001.jpg,002.jpg.003.jpg,123.jpgに抽出されるようになっております。 しかし、仮名のファイルですが、123.jpgというファイル名が最初の列に抽出されたほうがこちらとしましても都合がいいので、同じ名前のファイルがあったら先頭に抽出できるようにしたいのですがどのようにしたらよろしいでしょうか？

  • マクロ　IF条件分岐　疑問

    マクロ初心者です。いろいろ参考に以下のマクロを作ってみたのですが、最初、私はnBold >0になると思いましたが、nBold < 0が正解のようですね。どうして0以下というふうにするのですか？ Sub AからF列に太字あればJ列に◎() For nRow = 1 To 7 nBold = 0 For nCol = 1 To 6 nBold = nBold + Cells(nRow, nCol).DisplayFormat.Font.bold Next nCol If nBold < 0 Then Cells(nRow, 7) = "◎" Else Cells(nRow, 7) = "" End If Next nRow End Sub

  • このマクロの繰り返し？

    ＶＢＡ初心者です。 これを、繰り返し（入れ子）でもっと省略できますか？ Sub test() Dim retu1 As Integer retu1 = 50 Do While retu1 >= 1 Cells(retu1, retu1 + 50).Interior.ColorIndex = 9 retu1 = retu1 - 1 Loop 'ココから先をもっと簡単にしたいです！ retu1 = 50 Do While retu1 >= 1 Cells(retu1 + 1, retu1 + 50 - 1).Interior.ColorIndex = 9 retu1 = retu1 - 1 Loop retu1 = 50 Do While retu1 >= 1 Cells(retu1 + 2, retu1 + 50 - 2).Interior.ColorIndex = 9 retu1 = retu1 - 1 Loop End Sub どなたか、お願いします。

  • ユーザーフォームの入力時のマクロについて

    いつもお世話になります。 Windows7 excell2010 です。 今まさにVBAをやり出してあまりわかっていませんが下記のようにまでになったところです。 ご指導をいただきたいのは、 参照図にあるUserForm1に入力するとき、 「日付」　ime が　半角数値 「顧客名」ime が　ひらがな 「売上」　ime が　半角数値 を自動的にする　マクロ　を記述したいです。 ご指導いたたければ幸いです。 下記のようなマクロが記述されています。 ※UserForm1 コード表示 Private Sub CommandButton1_Click() n = 1 Do n = n + 1 Loop While Cells(n, 1) <> "" Cells(n, 1) = UserForm1.TextBox1.Text Cells(n, 2) = UserForm1.TextBox2.Text Cells(n, 3) = UserForm1.TextBox3.Text Unload Me End Sub Private Sub CommandButton2_Click() Unload Me End End Sub ※標準モジュール Sub FormSample() Do UserForm1.Show Loop End Sub Sub Test() MsgBox "ボタンによるマクロの実行" End Sub

  • マクロの解読に困っています

    マクロの仕事がきましたが、初めてで苦戦しています。 ５冊くらい本を読みながら、今あるマクロの解読をしています。 しかし、次のErrShori：の意味がどうしてもわかりません。 わかる方がいらっしゃいましたらぜひ教えてください。 ErrShori: Open sFilename & ".csv" For Output Shared As #1 その前の文もつけておきます。 Sub Auto_Close() On Error GoTo ErrShori Dim MaxPage As Integer Dim sFilename As String Dim sFilename2 As String Dim i As Integer Dim j As Integer Dim sKensaku As String MaxPage = 0 Do MaxPage = MaxPage + 1 Loop Until Cells(MaxPage * 17 + 21, 1) = "" ChDrive "W" ChDir "W:\" sFilename = Range("O22") sFilename2 = sFilename & ".csv" Workbooks(sFilename2).Close SaveChanges:=False ErrShori: Open sFilename & ".csv" For Output Shared As #1 以上です。 質問の仕方が悪かったらすみません。

  • 置換後に太く赤字にしたいです

    めぐみと申します。 以前に兄に以下のマクロを作ってもらいました。 エクセルにある文字を置換してくれるマクロです。 置換後の文字を太く赤字にしたいですがそのようにすればいいでしょうか？ 恐れ入りますが知っている方がいらっしゃりましたら教えて頂けないでしょうか？ よろしくお願いいたします。 Sub ワード置換() Dim wdObj As New Word.Application Dim buf As String buf = Dir(ActiveWorkbook.Path & "\*.doc") Do While buf <> "" wdObj.Documents.Open ActiveWorkbook.Path & "\" & buf n = 1 Do While ActiveSheet.Cells(n, 1) <> "" fdtxt = ActiveSheet.Cells(n, 1) rptxt = ActiveSheet.Cells(n, 2) With wdObj.Selection.Find .Text = fdtxt .Replacement.Text = rptxt .Forward = True .Wrap = wdFindContinue End With wdObj.Selection.Find.Execute Replace:=wdReplaceAll n = n + 1 Loop buf = Dir() Loop wdObj.Quit End Sub

  • Do～Loopステートメント

    Do～Loopステートメントで使わな方が良いステートメントとは？ Do～Loopステートメントで「古いから使わない方がよい」、と言われたことがあるのですが どれの事だか忘れてしまいました。 Sub test() セルのA1～A10に1～10を入力する i = 1 Do While i < 11 Worksheets("Sheet1").Cells(i, 1).Value = i i = i + 1 Loop End Sub これは一般的だから使ってもよいと思います。 Sub test() セルのA1～A10に1～10を入力する i = 1 Do Until i = 11 Worksheets("Sheet1").Cells(i, 1).Value = i i = i + 1 Loop End Sub これもよく見かけます。 Do While,Do Until以外にもloopステートメントってありますか？ あと使わない方が良いステートメント、私の勘違いでなければ教えてください。

  • DIR関数を使ったファイル名の取得

    おはようございます。 txtファイル名とdocファイル名を取得したく、以下のコードを作成してみました。 DIR関数を使って、ファイルリストボックスのPatternプロバディのように、複数の形式のファイル名を同時に取得する方法はあるのでしょうか? 是非、教えてください。よろしくお願いします。 ----------------------------- Private Sub Form_Load() Dim MyName MyName = Dir("C:\My Documents\*.txt") Do While MyName <> "" MsgBox MyName MyName = Dir Loop MyName = Dir("C:\My Documents\*.doc") Do While MyName <> "" MsgBox MyName MyName = Dir Loop End End Sub -------------------------------------

  • File = Dir　は何をしてるのでしょう？

    ｖｂａです。 ---------------------------- Sub フォルダの中にあるファイルとフォルダを書き出す() Dim File As String File = Dir("C:\*.*", vbDirectory) Do While File <> "" Debug.Print File File = Dir Loop End Sub ---------------------------- このコードを実行すると、 フォルダの中にあるファイルとフォルダを書き出されるのですが File = Dir のコードは何をしているのでしょうか？ 引数なしのDirの使い方もよくわからないし File = Dirがある事によってどういう効果があるのかもわかりません。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する