戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
フォルダ内のデータを順に処理したい

    [191639] フォルダ内のデータを順に処理したい-

    ■親トピック/記事引用/メール受信=ON■

    □投稿者/ haru -(2020/03/23(12:40))
    □U R L/
      初めてご質問させていただきます。
      フォルダ内のエクセルデータ全てに、VBAで処理をしようとしましたが、
      フォルダ内の1個目のデータのみを処理してループしてくれません。
      (※フォルダ内には5個の.xlsxが入っています)
      デバックしながら見てみましたがわからなかったので、お詳しい方が居ましたら、ご指摘頂けると助かります。
      
      現状、以下のコードですと、
      フォルダ内の1個めのデータを開き、「Hellow」が表示され、精製した「ProcessedData」フォルダ内に1個目のデータのみが保存されています。
      
      
      Sub 病院データスクレイピング()
      	dim mypath as string
      	dim myfile as string
      	dim LoopCount as Long
      	Dim dlg As FileDialog
      	
      	LoopCount = 0
      	
      	'ファイルの選択ダイアログを表示して
      	'ファイルのパスを取得します
      
      
      	Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
      
      	'キャンセルボタンクリック時にマクロを終了
      	If dlg.Show = False Then Exit Sub
      
      	'フォルダーのフルパスを変数に格納
      	mypath = dlg.SelectedItems(1) & "\"
      
      
      	'指定フォルダのブックを順繰り拾う
      	myfile = dir(books & "*.xls*")
      	do until myfile = ""
      
      	'ブックを開く
      	workbooks.open mypath & myfile
      	
      	'シートのアクティブ化
      	Workbooks(myfile).Activate
      
      	
      	'///////////////////////ここから処理を記載
      
      	MsgBox "Hellow"
      
      	'///////////////////////ここまで処理を記載
      	
      	'フォルダ生成
      	Dim FolderName As String
          FolderName = mypath & "ProcessedData"
          
          '同名のフォルダがない場合フォルダを作成'
          If Dir(FolderName, vbDirectory) = "" Then
              MkDir FolderName
          End If
          
      	LoopCount = LoopCount + 1
      	
      	'保存して閉じる
      	ActiveWorkbook.SaveAs _
      	Filename:=FolderName & "\" & PrefectureName & LoopCount &".xlsm", _ 
      	FileFormat:=xlOpenXMLWorkbookMacroEnabled
      	ActiveWorkbook.Close SaveChanges:=False
      	
      	'フォルダ内処理ループ
      	myfile = dir()
      	loop
      
      End Sub
      
      
      
      OS:WIN10
      excelバージョン:365


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191640] (削除)-

    記事引用/メール受信=OFF■

    □投稿者/ / -(2020/03/23(16:04))
    □U R L/

      この記事は削除されました




    [191641] Re[2]: フォルダ内のデータを順に処理したい-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/03/23(16:26))
    □U R L/
      下記の処理の位置を検討するのが先でしたね。
      
      繰り返しのなかで何度も行う必要はなく、最初に一度だけ
      実行すればよいのでは?
      それが終わってから、Dir()を使ったファイル取得を繰り返せばよいのでは?
      
              'フォルダ生成
              Dim FolderName As String
              FolderName = mypath & "ProcessedData"
      
              '同名のフォルダがない場合フォルダを作成'
              If Dir(FolderName, vbDirectory) = "" Then
                  MkDir FolderName
              End If


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191642] Re[3]: フォルダ内のデータを順に処理したい-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2020/03/24(21:23))
    □U R L/
      動作確認していませんが、こういうことかと思います。
      そちらで確認して下さい。
      
      Sub 病院データスクレイピング()
          Dim mypath As String
          Dim myfile As String
          Dim LoopCount As Long
          Dim dlg As FileDialog
          Dim wb As Workbook      '■追加
          Dim books As String     '■追加
          
          LoopCount = 0
      
          'ファイルの選択ダイアログを表示して
          'ファイルのパスを取得します
      
          Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
      
          'キャンセルボタンクリック時にマクロを終了
          If dlg.Show = False Then Exit Sub
      
          'フォルダーのフルパスを変数に格納
          mypath = dlg.SelectedItems(1) & "\"
          
          'フォルダ生成
          Dim FolderName As String
          FolderName = mypath & "ProcessedData"
      
          '同名のフォルダがない場合フォルダを作成'
          If Dir(FolderName, vbDirectory) = "" Then
              MkDir FolderName
          End If
      
          '指定フォルダのブックを順繰り拾う
          myfile = Dir(books & "*.xls*") ' ■要修正← booksって何?どこで定義?
          
          Do Until myfile = ""
      
              'ブックを開く
              Set wb = Workbooks.Open(mypath & myfile)
      
              'シートのアクティブ化
              'Workbooks(myfile).Activate ' →不要かと。
      
              '///////////////////////ここから処理を記載
      
              MsgBox "Hellow"
      
              '///////////////////////ここまで処理を記載
              
              LoopCount = LoopCount + 1
      
              '保存して閉じる
              wb.SaveAs _
                      FILENAME:=FolderName & "\" & PrefectureName & LoopCount & ".xlsm", _
                      FileFormat:=xlOpenXMLWorkbookMacroEnabled
              wb.Close SaveChanges:=False
      
              'フォルダ内処理ループ
              myfile = Dir()
          Loop
      End Sub
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191643] Re[4]: フォルダ内のデータを順に処理したい-

    解決!!ありがとうございました! / 記事引用/メール受信=OFF■

    □投稿者/ haru -(2020/03/25(09:45))
    □U R L/
      ご回答・ご指摘ありがとうございます!
      また、確認が遅くなってしまい申し訳ありませんでした。
      ご指摘頂いたbooksの部分が誤っておりました。
      
      最終的に以下のコードで保存するところまで確認出来ました。
      
      Sub 病院データスクレイピング()
          Dim mypath As String
          Dim myfile As String
          Dim LoopCount As Long
          Dim dlg As FileDialog
          Dim wb As Workbook
          Dim books As String
          
          LoopCount = 0
      
          'ファイルの選択ダイアログを表示して
          'ファイルのパスを取得します
      
          Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
      
          'キャンセルボタンクリック時にマクロを終了
          If dlg.Show = False Then Exit Sub
      
          'フォルダーのフルパスを変数に格納
          mypath = dlg.SelectedItems(1) & "\"
          
          'フォルダ生成
          Dim FolderName As String
          FolderName = mypath & "ProcessedData"
      
          '同名のフォルダがない場合フォルダを作成'
          If Dir(FolderName, vbDirectory) = "" Then
              MkDir FolderName
          End If
      
          '指定フォルダのブックを順繰り拾う
          myfile = Dir(mypath & "*.xls*")
          
          Do Until myfile = ""
      
              'ブックを開く
              Set wb = Workbooks.Open(mypath & myfile)
      
      
              '///////////////////////ここから処理を記載
      
              MsgBox "Hellow"
      
              '///////////////////////ここまで処理を記載
              
              LoopCount = LoopCount + 1
      
              '保存して閉じる
              wb.SaveAs _
                      Filename:=FolderName & "\" & PrefectureName & LoopCount & ".xlsm", _
                      FileFormat:=xlOpenXMLWorkbookMacroEnabled
              wb.Close SaveChanges:=False
      
              'フォルダ内処理ループ
              myfile = Dir()
          Loop
      End Sub
      
      大変勉強になりました。
      ありがとうございました。


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他



このトピック内容の全ページ数 / [0]

このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->  図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決!!ありがとうございました! 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜! Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内) 


- Child Forum -
Edit:ゆう-G