VBAでNAS上の共有フォルダ内のファイルに書き| OKWAVE

VBA

Excel VBAでユーザーフォームを使ったアンケート入力フォームを作成しましたが、「確定」という名称のコマンドボタンをクリック実行時に別のExcelブック内の各セルにオプションボタンのキャプション（値）とテキストボックスの内容を反映（転記）させて、上書き保存させていく記述内容についてご教示頂けませんでしょうか。具体的には、問(1)の回答は、別ブックのセルC5に反映させ、問(2)の回答は、D5に反映、問(3)の回答は、E5に反映、問(4)の回答は、F5に反映、問(5)の回答は、G5に反映、問(6)の回答は、H5に反映、その他のテキストは、I5に反映させるといった動作にさせるため、下記の内容で「標準モジュール」の構文と「フォーム」の構文を記述してみたのですが、このとおりどうさせるための具体的な構文が思い当たりません。環境はExcel 2013です。どうにもならず困っているため、どうか宜しくお願い致します。～標準モジュールの構文～ 'ユーザーフォームに入力された転記先Book（アンケート回答結果.xlsx）の有無を確認 '及び転記先Book（アンケート回答結果.xlsxを開く事が可能な状況かどうかの確認 Sub Confirm_posting_place( _ ByVal myInformation As String, _ ByRef PostingOK As Boolean, _ ByRef StoragePath As String, _ ByRef PostFileName As String, _ ByRef PostSheetName As String) Dim buf As Variant StoragePath = "U:\Director" '転記先Bookファイルが存在するフォルダーのパス PostFileName = "アンケート回答結果.xlsx" '転記先Bookのファイル名 PostSheetName = "Sheet1" '転記先Bookのファイル上のワークシート名 buf = "" On Error Resume Next buf = Windows(PostFileName).Caption On Error GoTo 0 If buf = PostFileName Then PostingOK = Windows(PostFileName).Parent.Path = StoragePath Else PostingOK = True End If If Dir(StoragePath, vbDirectory) = "" Then PostingOK = False MsgBox "「アンケート回答入力フォーム」の投書内容の保存先のファイルがあるフォルダーとして" _ & "設定されているフォルダが見当たらないため、" & myInformation _ & vbCrLf & vbCrLf & "「アンケート回答入力フォーム」を利用される方は、このトラブル内容を" _ & "「アンケート回答入力フォーム」の開発者へ報告して対応してもらうようにして下さい。" _ , vbExclamation, "《トラブル報告》保存先ファイル不明" ElseIf Dir(StoragePath & "\" & PostFileName) = "" Then PostingOK = False MsgBox "「アンケート回答入力フォーム」の投書内容の保存先のファイルとして設定されている" _ & vbCrLf & vbCrLf & PostFileName & vbCrLf & vbCrLf & _ "が所定のフォルダー内には見当たらないため、" & myInformation _ & vbCrLf & vbCrLf & "「アンケート回答入力フォーム」を利用される方は、このトラブル内容を" _ & "「アンケート回答入力フォーム」の開発者へ報告して対応してもらうようにして下さい。" _ , vbExclamation, "《トラブル報告》保存先フォルダー不明" Else buf = Chr(0) On Error Resume Next buf = ExecuteExcel4Macro("'" & StoragePath _ & "\[" & PostFileName & "]" & PostSheetName & "'!R65536C256") On Error GoTo 0 If buf = Chr(0) Then PostingOK = False MsgBox "「アンケート回答入力フォーム」の投書内容の保存先として設定されている" _ & vbCrLf & vbCrLf & PostFileName & vbCrLf & vbCrLf & _ "というExcelBookの中には、投書内容の転記先として設定されている" _ & vbCrLf & vbCrLf & PostSheetName & vbCrLf & vbCrLf & _ "というシート名のシートが見当たらないため、" & myInformation _ & vbCrLf & vbCrLf & "「アンケート回答入力フォーム」を利用される方は、このトラブル内容を" _ & "「アンケート回答入力フォーム」の開発者へ報告して対応してもらうようにして下さい。" _ , vbExclamation, "《トラブル報告》保存先シート不明" ElseIf Not PostingOK Then Windows(PostFileName).Activate MsgBox "「アンケート回答入力フォーム」の投書内容の保存先のExcel Bookとして設定されている" _ & vbCrLf & vbCrLf & PostFileName & vbCrLf & vbCrLf & _ "と同名の別Book(保存先フォルダが異なるBook)が開いているため、 " _ & myInformation & vbCrLf & vbCrLf _ & "「アンケート回答入力フォーム」を利用される場合には、現在開かれている" & vbCrLf & vbCrLf _ & Left(PostFileName, InStrRev(PostFileName, ".") - 1) & vbCrLf & vbCrLf & _ "というWindowのExcel Bookを閉じても問題がないか否かを確認し、" _ & "特に問題がない場合には、そのWindowのExcel Bookを閉じてから、" _ & "このフォームを開き直して下さい。" _ , vbExclamation, "保存先ファイルへのアクセス不能" End If End If End Sub ～フォームの構文～の内容については、文字数制限で収まりきれないため、この後すぐ私のユーザー名で新規質問の方で続きを書き込みいたしますので、そちらをご覧ください。

VBA

～フォームの構文～の続きです。 '[確定]ボタンをクリックした時の処理 Private Sub ConfirmButton_Click() Const NumberColumn As String = "A" '転記先のシートにおいて連番を記入する列の列番号 Const DateColumn As String = "B" '転記先のシートにおいて意見が投書された日付を記入する列の列番号 Const DepartmentColumn As String = "C" '転記先のシートにおいて所属部署名を転記する列の列番号 Const TextColumn As String = "D" '転記先のシートにおいて投書内容を転記する列の列番号 Const myGroupName As String = "DepartmentSelect" '所属部署選択用のオプションボタンのGroupNameプロパティに設定した値 Dim StoragePath As String, PostFileName As String, PostSheetName As String _ , Department As String, myText As String, PostBook As Workbook _ , PostRow As Long, PostingOK As Boolean, myWindow As Window _ , buf As Variant, co As Control, myInformation As String _ Department = "": myText = "" For Each co In Opinion_Box.Controls If TypeName(co) = "OptionButton" Then If co.Value = True And co.GroupName = "DepartmentSelect" Then _ Department = co.Caption End If Next co myText = Contents_of_posting.Value myInformation = "" If Department = "" Then myInformation = "選択回答 " If myText = "" Then myInformation = myInformation & "その他" myInformation = Replace(RTrim(myInformation), " ", "と") If myInformation = "" Then Select Case MsgBox("下記の内容が入力されています。" & vbCrLf _ & "この内容でアンケートを送信してよろしいですか？" & vbCrLf _ & "　[はい] : この内容でアンケートを送信します。" & vbCrLf _ & "　[いいえ] : 入力フォームに戻って投書内容を修正します。" & vbCrLf _ & "　[キャンセル] : 投書を中止して入力フォームを閉じます。" _ & vbCrLf & vbCrLf & "【】 " & Department _ & vbCrLf & vbCrLf & "【】 " & vbCrLf & myText _ , vbYesNoCancel + vbInformation, "アンケート内容確認") Case vbYes GoTo Label_Posting Case vbCancel Unload Me End Select Exit Sub Else If MsgBox( _ myInformation & "が入力されていません。" & vbCrLf & vbCrLf _ & "[再試行] : フォームでの入力に戻ります。" & vbCrLf _ & "[キャンセル] : 入力を中止し、フォームを閉じます。" _ , vbRetryCancel + vbExclamation, "未入力項目あり") _ = vbCancel Then Unload Me Exit Sub End If Label_Posting: myInformation = vbCrLf _ & "フォームに入力いただいた内容を投函することができません。" Call Confirm_posting_place(myInformation, PostingOK _ , StoragePath, PostFileName, PostSheetName) With Application .ScreenUpdating = False .Calculation = xlManual .DisplayAlerts = False End With buf = "" On Error Resume Next Set PostBook = Windows(PostFileName).Parent buf = PostBook.Path On Error GoTo 0 If buf = StoragePath Then Set myWindow = PostBook.Windows(1).NewWindow Else Set PostBook = Workbooks.Open(StoragePath & "\" & PostFileName) Set myWindow = PostBook.Windows(1) End If myWindow.Visible = False With PostBook .Windows(.Windows.Count).Visible = False ThisWorkbook.Activate With .Sheets(PostSheetName) PostRow = 0 PostRow = .Range(DateColumn & .Rows.Count).End(xlUp).Row + 1 .Range(NumberColumn & PostRow).Value _ = Int(WorksheetFunction.Max(.Columns(NumberColumn))) + 1 With .Range(DateColumn & PostRow) .Value = Date .NumberFormatLocal = "ggge""年""m""月""d""日""(aaa)" End With .Range(DepartmentColumn & PostRow).Value = Department .Range(TextColumn & PostRow).Value = myText End With End With With myWindow .Visible = True .Parent.Save .Close End With ThisWorkbook.Activate With Application .Calculation = xlAutomatic .ScreenUpdating = True .DisplayAlerts = True End With MsgBox "ありがとうございました！アンケート回答入力内容が送信完了しました。", vbInformation, "完了" Unload Me End Sub 以上です。宜しくお願いします。

サブフォルダの親フォルダを変えたい

フォルダの中のサブフォルダを取得してくて、 http://officetanaka.net/excel/vba/tips/tips95.htm の --------------------------------------------------------- Sub Sample4() Dim buf As String, msg As String buf = Dir("*.*", vbDirectory) Do While buf <> "" If InStr(buf, ".") = 0 Then msg = msg & buf & vbCrLf buf = Dir() Loop MsgBox msg End Sub --------------------------------------------------------- をやってみたら、サブフォルダを取得できたのですが、上記のコードを実行すると元々のフォルダのパスが「C:\Users」で、「C:\Users」のサブフォルダが取得されてしまいます。でも上記のコードでは、「C:\Users」は指定してないと思うのですが、なぜ「C:\Users」のサブフォルダが取得されてしまうのでしょうか？例えば「C:\Users」ではなく、「C:\Program Files」のサブフォルダを取得するには、どのようにコードを書き換えればいいのでしょうか？ご教授よろしくお願いします。

VBAフォルダ内ファイル入出力について

Accessで特定のフォルダ内にあるcsvファイルを全て読み込み、別のｃｓｖファイルへ出力するという処理を作りたいのですが、最近からVBAを始めたばかりでどうすればよいか分かりません。とりあえず、特定のファイルをひとつ読み込み、別ファイルへ出力することはできました。 Option Compare Database Private Sub Button_Click() Dim No As Integer Dim buf No = FreeFile Open "C:\test1.csv" For Input As #1 Open "C:\test2.csv" For Output As #2 Do Until EOF(No) Line Input #1, buf Print #2, buf Loop MsgBox "処理終了" Close #1 Close #2 End Sub 読み込み対象を「特定のフォルダ内のファイル全て」にする方法が知りたいです。ちなみに出力先のファイルはひとつにまとめてもそれぞれ別のファイルに出力でもどちらでも構いません。できれば両方教えていただければ有難いです。宜しくお願いします。

VBA ユーザーフォームの内容を別ブックに反映

「ユーザーフォーム.xlsm」のファイル名でVBAのユーザーフォームを作成しました。このユーザーフォームで入力した内容値を別ブックである「ご意見箱.xlsx」のsheet1に反映させたいです。「ユーザーフォーム.xlsm」と「ご意見箱.xlsx」は、「デスクトップ」上に置いております。ユーザーフォーム上の「確定保存」というコマンドボタンをクリックしたタイミングで以下のようなイベントの構文で記述しました。 (1)バックグラウンドで「ご意見箱.xlsx」をファイルオープンさせて (2)「ご意見箱.xlsx」の「sheet１」の最終行を取得して (3)最終行の連番を振り (4)オプションボタンの選択値とテキストボックスの内容を書き込み反映して (5)自動で上書き保存して閉じる。 (6)もしオプションボタンの未選択かテキストボックスの未入力があった場合は、警告メッセージを表示させる現状では(1)のバックグラウンドでのファイルオープンまでは問題なく動作しているのですが、(2)以降で躓いている状況です。ユーザーフォームの構成と反映先となる「ご意見箱.xlsx」ファイルのsheet1の構成は、画像添付のとおりとなっております。使用アプリケーション：Excel 2013です。ここに辿り着くまでにさんざん書籍やWEBなどで調べに調べまくってトライ＆エラーを繰り返してきたのですが、もしお分かりになる方がいらっしゃいましたら、皆様にご教示賜りたく何卒宜しくお願い申し上げます。

【VBA】　ファイル名の取得

２３歳OLです。会社でマクロを組んでいるのですが、できないところがあったのでご相談させてください。 ▼やりたいこと ================================================ ・フォルダを自分で指定して、選択したファイルの名前をシートに書き込む 1.txt 2.log 3.xls　とフォルダに入っていたら 1.txt 2.log 3.xls とシートに名前を書き込んでほしいです。・ファイルの種類はいろいろある。(txt.logなど) ================================================ ▼現在書いてみたコード ======================== Sub Sample1() Dim buf As String, cnt As Long Const Path As String = "" buf = Dir(Path & "*.*") Do While buf <> "" cnt = cnt + 1 Cells(cnt, 1) = buf buf = Dir() Loop End Sub ======================== これだと、初めから指定したフォルダしか取得することができないらしいです。そもそもConst Path As String = "このぶぶん" このぶぶんにフォルダを指定しても動きませんでした。？どこが原因なのでしょうか？ご教示お願いします。

複数フォルダに格納されたファイル名取得VBA

お世話になっております。あるフォルダに複数のフォルダが格納されており、更にそのフォルダの中にあるファイルの情報を取得するプログラムを書いたのですが、実行すると下記のようなエラーとなってしまいます。 ■エラープロシージャの呼び出し、または引数が不正です下から3行目、「buf = Dir()」が問題であることはわかるのですが、何が問題でどのように解決したらいいかわかりません。どなたかご教授の程よろしくお願い致します(>_<) ------------------------------------------------------------------------ Sub test() Dim buf As String Dim fName As String Dim msg As String buf = Dir("*.*", vbDirectory) Do While buf <> "" If GetAttr(buf) And vbDirectory Then If buf <> "." And buf <> ".." Then fName = Dir(CurDir & "\" & buf & "\" & "*.jpg") Do While fName <> "" cnt = cnt + 1 Cells(cnt, 1) = buf Cells(cnt, 2) = fName msg = msg & buf & "\" & fName & vbCrLf fName = Dir() Loop MsgBox msg End If End If buf = Dir() Loop End Sub ------------------------------------------------------------------------ これが実現できないと細かい作業を毎日繰り返す事となり、かなり業務不可が高いです。。繰り返しになってしまいますが、どなたかご回答よろしくお願い致します。

VBAで任意のフォルダ内のファイルの特定の文字列を

お世話になります。今、Excelを使用しVBAで任意のフォルダ内に含まれるファイル（txt形式ですが拡張子はありません）から、特定のA～Bの部分の文字列のみを抜き出し、ExcelのSheetに出力させるというVBAを作成しようと考えています。また、A～Bで抽出した文字列内に”空白”が含まれる場合、その空白でセルを隔てるという処理を加えたいです。また、それらとは別に任意のフォルダ内に含まれるファイルのファイル名のみを抽出し、Excelに出力するというVBAも作ろうと考えています。私自身、これまでExcelでは関数を使うのが精一杯でVBAの勉強すらしてきませんでしたので、だいぶ困窮しております。どなたか、VBAについて詳しい方、ご教授いただけたら幸いです。以下は、参考までに、特定のフォルダ内に含まれるファイルをSheetに出力するVBAになります。ここからさらに、任意の文字列を検索し、抽出し、出力する機能と、また空白部分でセルを分ける機能、またファイル名一覧を抽出する機能を加えていきたい所存です。どなたか、お力添えの程何卒よろしくお願い致します。 Sub GetAllFile() Dim buf As String, tmp As Variant, cnt As Long, i As Long Dim myFol As String, myFile As String Dim fNo As Integer, myCol As Long With Application.FileDialog(msoFileDialogFolderPicker) .Title = "*** 対象フォルダを選択し、[OK]をクリック ***" .InitialFileName = "C:\" If .Show = True Then myFol = .SelectedItems(1) End If End With myFile = Dir(myFol & "\*") myCol = 0 Do While myFile <> "" fNo = FreeFile Open myFol & "\" & myFile For Input As #fNo Do Until EOF(fNo) Line Input #fNo, buf tmp = Split(buf, ",") cnt = cnt + 1 For i = 1 To UBound(tmp) + 1 Cells(cnt, i + myCol) = tmp(i - 1) Next i Loop Close #fNo myFile = Dir() myCol = myCol + 4 cnt = 0 Loop End Sub 上記、VBAは動作はしましたが、やはりフォルダ内のファイル数の数により、途中でフリーズしてしまう事もありました。ご教授の程、何卒よろしくお願い致します。

フォルダ内にあるファイル名を取得するVBA

エクセル2010を使用しています。 VBA（マクロ）で以下の作業を実行したいと考えていますが、初心者につき、ご教示いただけますでしょうか。「マクロ」ファイルにある「実行」Sheetというにある「実行」ボタンで L2に入力したパス内にあるファイル（.xlsや.xlsmや.xlsbが混在しますが、基本的には全てエクセルファイル）のファイル名を K8から下へ取得したいのですが・・参考にしたコードでは　うまく動作しませんでした。以下では、L2のパスを参照するのも組めていないため、コード内に直接パスを書き込んでいますが実際は、パスを変動させて使いたいので、L2を参照できるようになると助かります。 ※パスは、質問用に仮置きで「パス」としています。 Sub Sample() Dim buf As String, cnt As Long Const Path As String = "パス" buf = Dir(Path & "*.*") Do While buf <> "" cnt = cnt + 8 Cells(cnt, 11) = buf buf = Dir() Loop End Sub また、このコードでは実行ファイル自体のファイル名も取得してしまうようなので、実行ファイル以外のファイル名を取得したいです。ご指導のほど、よろしくお願い致します。

エクセルVBAでフォルダ内の全てのファイルにマスタファイルのsheet

エクセルVBAでフォルダ内の全てのファイルにマスタファイルのsheet1！B2：X200の値を、同じく各ファイルのsheet1！B2：X200に書き込み、保存させるにはどのようにすればよいでしょうか？またそんなことは出来るのでしょうか？ご教授願います。

VBA サブフォルダ内のエクセルファイル転記

VBAについてお尋ねします。当方VBA初心者です。やりたい事は下記です。・サブフォルダ(2階層目)に入っているエクセルファイルからマクロ実行ファイルにセルデータを転記・全てのサブフォルダを網羅サブフォルダに対しての扱いが難しくて理解に困ってます。サルプルなどありましたらいただけると幸いです。よろしくお願いします。

Excel VBA インデックスが有効範囲にない

　よろしくお願いします。 Excel VBA　初心のものです。プログラムを作ってみたのですが、「インデックスが有効範囲にありません」となってその先に進めません。ソースですが ------------------------------------------------------ Private Sub CommandButton1_Click() Dim buf As String, cnt As Long Dim TMP As Variant Const Path As String = "D:\Excel\sample\" buf = Dir(Path & "*.xls*") Set TMP = Workbooks(buf).Sheets("testdata").Range("A1").Value Do While buf <> "" cnt = cnt + 1 Cells(cnt, 1) = buf Cells(cnt, 2) = FileDateTime(Path & buf) Cells(cnt, 3) = TMP buf = Dir() Loop End Sub ------------------------------------------------------ エラーになる箇所は Set TMP = Workbooks(buf).Sheets("testdata").Range("A1").Value のところです。このプログラムで何をしたいかと言いますと DドライブのExcel＞sample　というフォルダの中にある・すべてのエクセルブック名（ファイル数は３個）と、・そのブックの作成日時と、・testdataというシート（各ブックに必ずあるシートです）のセルA1に入っている値を実行ファイルのSheet1に書き出す、というものです。プログラムの実行ファイルはExcelフォルダ直下にあります。どこが問題でエラーになっているのか分かりません。ご指南よろしくお願いします。　　

ｃｓｖファイルをｖｂａで読み込みたいけど文字化け

エクセル２００７です。 http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_020.html を参考にｃｓｖファイルをシートに書きだそうとしてるのですが、リンク先のサンプルコードのの Input #intFF, X(1), X(2), X(3), X(4), X(5) の部分で、ファイルにこれ以上データがありません。(Error 62) と言うエラーになってしまいます。元のｃｓｖファイルは、サンプル通り５項目（Ａ列～Ｅ列）にしてみましたがエラーになってしまいます。なので、 http://officetanaka.net/excel/vba/error/execution_error/error_62.htm を参考に、 Sub Sample1() Dim buf As String Open "C:\Users\test\Downloads\test.csv" For Input As #1 Do Until EOF(1) Line Input #1, buf Loop Line Input #1, buf Close #1 End Sub としてみたところ、やっぱり同じエラーになって、 ?bufをしたら、 ヨS_蘰 gqが返ってきました。文字化けしてるようですが、フィールド（１行目）に日本語が入っていますがそれが原因なのでしょうか？日本語が入ってるｃｓｖファイルをｖｂａで書き出す事は不可能なのか教えてください。

VBA 複数ファイルの操作

初心者のため教えてください m(__)m 現在VBAにて処理を簡単にしたいと考えておりますやりたいことは、同一フォルダ「TEST」に20個ほど.xlsxファイルがあります。そのそれぞれのブックにはシートが４つに分かれており「data」というシートのA3～AU3のデータを集約.xlsmの「まとめ」というシートに転記したいです。また、・追記するされる際に一番左側（A）には番号を自動で振りたい。（1.2.3.4.....）・データはB2から貼り付け、最終行にどんどん追記されるようにしたい・ファイルを開かずに実行したい・最後に転記完了のメッセージを出したいいろいろとサイトで調べているのですがなかなか進まず助けて頂けると幸いです。よろしくお願いいたします

エクセル2003のVBAを教えてパート３

kドライブのVBA練習フォルダにある、全てのテキストデータファイル(拡張子.txt)を、エクセルに繋げて取り込こむ(指定のエクセルの1シートに全テキストデータを繋げて取り込む)方法がわかりません。どなたか教えてください。データは、A列にのみに入ります。テキストデータファイルの数は、1～4ファイルと色々な場合があります。また、行数も1ファイル10行～ 400行と色々です。次のように、決められた1つのデータなら、プログラムに「元データ.txt」と入力する方法で出来るのでっすが。 Sub テキストファイルの読み込み()　'1ファイルのとき　Dim buf As String 　Dim cnt As Long 　Open "k:\VBA練習\元データ.txt" For Input As #1 　　Do Until EOF(1) 　　　Line Input #1, buf 　　　cnt = cnt + 1 　　　Cells(cnt, 1) = buf 　　Loop End Sub

ExcelのVBAについて

こんにちは、VBA初心者です。 C:\pictureの中に以下のファイルがあります。 DSC_0134.JPG～DSC_0154.JPG これらのファイルをExcelのA列1～20行に書かれた文字△○％＆◎～▲▽％％★に.JPGをつけて保存したくて以下のコードを書きました。 Dim buf As String Dim msg As String Dim i As Integer Dim A As Variant i = 1 buf = Dir("dsc*.jpg", vbNormal) Do While buf <> "" Do While i < 21 buf = Dir() msg = buf 'msg=元の名前 A = Worksheets("sheet1").Cells(i, 1).Value 　　　　Worksheets("sheet1").Cells(i, 2).Value = msg 　　　　　　　　Name "C:\picture\msg" As "C:\picture\A.jpg" 　　　　i = i + 1 Loop Loop Name "C:\picture\msg" As "C:\picture\A.jpg"のところで、「ファイルがありません。」となってしまいます。あと、Worksheets("sheet1").Cells(i, 2).Value = msgのところで、\pictureの中の最初のファイル（DSC_0134.JPG）を表示しません。どこを直せばよいのでしょうか？

vbaについて教えてください

エクセルでワークシートに貼ったコマンドボタンをクリックするとユーザーフォームを呼び出してかつ、ユーザーフォーム上のコンボボックスに指定フォルダ下のフォルダを表示するものを作りました。ユーザーフォーム上のコンボボックスに表示されたフォルダを切替選択するとリストボックスにそのフォルダ下のファイルを表示させたいのですがやり方がわかりませんので教えてください。

「Wordの表のセルの結合情報」をVBAで取得する

「Wordの表のセルの結合情報」をVBAで取得する方法 EXCELのVBAであれば、下記サイトの下記マクロで判断できるようなのですが、 Word VBAには、「MergeCellsプロパティ」が無くて、駄目でした。別の方法で判定出来ない物でしょうか？ http://officetanaka.net/excel/vba/tips/tips50.htm ---------------------------------------------------------------------- Sub Sample2() Dim i As Long, buf As String For i = 2 To 9 If Cells(i, 1).MergeCells Then buf = buf & Cells(i, 1).Address(0, 0) & "-->結合されています" & vbCrLf Else buf = buf & Cells(i, 1).Address(0, 0) & "-->結合されていません" & vbCrLf End If Next i MsgBox buf End Sub ヘルプを調べましたが、ざっと見たところ載っていないように思います。経験あるかた居たらご教授頂けると助かります。

フォルダ内にあるファイルを取得したい

エクセル2010を使用しています。 VBA（マクロ）で以下の作業を実行したいと考えていますが、初心者につき、ご教示いただけますでしょうか。「マクロ」ファイルにある「実行」Sheetというにある「実行」ボタンで L2に入力したパス内にあるファイル（.xlsや.xlsmや.xlsbが混在しますが、基本的には全てエクセルファイル）のファイル名を K8から下へ取得したいのですが・・参考にしたコードでは　うまく動作しませんでした。以下では、L2のパスを参照するのも組めていないため、コード内に直接パスを書き込んでいますが実際は、パスを変動させて使いたいので、L2を参照できるようになると助かります。 ※パスは、質問用に仮置きで「パス」としています。 Sub Sample() Dim buf As String, cnt As Long Const Path As String = "パス" buf = Dir(Path & "*.*") Do While buf <> "" cnt = cnt + 8 Cells(cnt, 11) = buf buf = Dir() Loop End Sub また、このコードではマクロを実行するファイル自体のファイル名も取得してしまうようなので、自身のファイル名以外のものを取得することは可能でしょうか。ご指導のほど、よろしくお願い致します。

エクセルVBAでファイル作成

エクセルVBAで、データをフィルタで抽出し、別なBOOKの指定シートに転記し、名前をつけて保存したいのです。一応、下記のコードでテストは成功しました。しかし下記コードでは1回ごとにデータの転記先を開かなくてはなりません。処理する件数が多いので、できればいちいち新たに開き直さなくともよい方法はないでしょうか？最初から開いておいて、転記後名前をつけて保存すると、開いていたファイルが閉じてしまい、うまくいきません。別BOOKでなく別シートに転記して、そのシートをMoveして別ファイル保存ならわかるのですが、今回はどうしても別BOOKに転記しなければなりません。よろしくお願いします。 Option Explicit Sub データ分割転記() 　　Dim myPth As String, fname As String 　　Dim myRng As Range, myC As Range 　　Dim i As Long, x As Long 　　Dim wb(2) As Workbook 　　Dim ws As Worksheet 　　Dim t As Single 　　t = Timer 　　Set wb(0) = ThisWorkbook 　　myPth = wb(0).Path 　　With wb(0).Sheets("Key") 　　　　Set myRng = .Range("A2", .Range("A2").End(xlDown)) 'KeyData 　　End With 　　　　For Each myC In myRng 　　　　Application.EnableEvents = False 　　　　Set wb(1) = Workbooks.Open(Filename:=myPth & "\20150806TEST.xlsm") 　　　　Set ws = wb(1).Sheets("List") 　　　　　　With wb(0).Sheets("DATA") 　　　　　　.Range("A1:J1").AutoFilter Field:=4, Criteria1:=myC.Value 　　　　　　.Range("A2", .Range("A2").SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy ws.Range("A9") 　　　　　　.ShowAllData 　　　　End With 　　　　With ws 　　　　　　x = .Cells(Rows.Count, "A").End(xlUp).Row 　　　　　　myC.Offset(, 2).Value = x　'行数確認　　　　　　.Range("A9").Value = 1 　　　　　　If x > 9 Then 　　　　　　　　.Range("A9").AutoFill Destination:=.Range("A9:A" & x), Type:=xlFillSeries '連番　　　　　　End If 　　　　End With 　　　　wb(1).SaveAs Filename:=myPth & "\作成ファイル\" & myC.Value & ".xlsm" 　　　　wb(1).Close (False) 　　　　Application.EnableEvents = True 　　　　i = i + 1 　　Next 　　MsgBox i & "件を完了" _ 　　& vbCrLf & Timer - t & " Sec." End Sub ＊Application.EnableEvents = False を使っているのば別BOOKが持つイベントマクロを作動させないためです。

VBAでNAS上の共有フォルダ内のファイルに書き

みんなの回答

お礼 2017/01/23 11:39