仕事を頑張る人のおしりトラブル対策

セルの値で
フォルダやファイル名とファイルの内容を一気に保存したいのですが、
どうしても式がわかりません。。

やりたいことはここにまとめてます。

http://bsmile.sakura.ne.jp/phptest/cc1.jpg


A列のフォルダと作って、

B行のファイル名で、

C行の内容のファイルを作りたいのです。


1については、
http://hamachan4.exblog.jp/10612140/

にある通り、

Dim mydir As String
Dim i As Integer

For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
mydir = "C:\Users\user\Desktop\test\" & Cells(i, 1).Value
If Dir(mydir, vbDirectory) = vbNullString Then MkDir mydir
Next i
MsgBox "完了しました"

End Sub

フォルダを作る事はできそうなのですが、


2のフォルダパスをどう指定したらいいのか?
(3はなんとなくできそうなですが、)
で、色々みたんですが、どうしてもわからずで、

どういったVBAを組めばこの動作ができるでしょうか?


どうかよろしくお願いいたします。

m(_ _)m

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

A 回答 (2件)

csvならこの程度、、、


Option Explicit
Sub Ottotto()
Const xPath0 = "C:\Users\user\Desktop\test\"
Dim xSheet As Worksheet
Dim xPath As String
Dim xName As String
Dim xText As String
Dim nn As Integer
Application.DisplayAlerts = False
Set xSheet = ActiveSheet
For nn = 1 To xSheet.Range("A" & Rows.Count).End(xlUp).Row
xName = xSheet.Cells(nn, "B").Value
xText = xSheet.Cells(nn, "C").Value
xPath = (xPath0 & xSheet.Cells(nn, "A").Value & "\")
If (Dir(xPath, vbDirectory) = vbNullString) Then
MkDir xPath
End If
ChDrive (Left(xPath, 1))
ChDir (xPath)
With Workbooks.Add
Worksheets(1).Cells(1, "A").Value = xText
.SaveAs (xPath & xName & ".csv")
.Close False
End With
Next
Application.DisplayAlerts = True
End Sub
    • good
    • 0
この回答へのお礼

神様
ありがとうございました!!
(^^)

お礼日時:2013/04/17 10:43

手操作とはすこし感覚が違うので戸惑ったんじゃないかな。

たぶん、見逃しただけだよ。

Openで、ファイルが無ければ作成されます。
http://home.att.ne.jp/zeta/gen/excel/c04p45.htm

この回答への補足

フォルダの設定の仕方がわからないんです。

Open "C:\Users\test.txt" For Binary As #

これは理解できるんですが、

UsersがA1のセルに書いてあるフォルダだった場合

Open "C:\" & Cells(1, 1).Value & "\test.txt" For Binary As #1

かなと思ったんですが、エラーになってどうしようもないんです。

このフォルダの指定方法が知りたいです。

補足日時:2013/04/17 10:21
    • good
    • 0

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

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

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

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

QExcelでセル内の文字をファイル名にする方法と、下のSheet1タブを2列にする方法は?

Excel2003です。OSはWinXPです。質問は2つです。

1.セル内の文字をファイル名にする方法は?
例えばA1セルに 1153 と入っていたら、ファイルの名前を付けて保存するとき、普通は Book1.xls となりますが、
これを 1153.xls とするにはどうしたらよいですか?

2.下のSheet1タブを2列にする方法は?
EXcelの下の方にシート切り替えがありますが、これを2列にするにはどうしたらよいですか?

Aベストアンサー

1は、前回の回答で間違いありませんが、もう少し詳しく処理方法を書きます。

(1)そのBookを開き、ツール→マクロ→新しいマクロの登録を選択。
(2)ダイアログボックスを確認、マクロ名(今回はMacro1のまま)を入力し、OK。
(3)そのBookを適当な名前(今回はBook1)で保存し、マクロの記録を終了。
(4)ツール→マクロ→マクロを選択、マクロ名を選択し、編集ボタンを押す。
すると、下記のようなモジュールが現れる。
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2006/8/29
'
ChDir "C:\Documents and Settings\管理者\保存するフォルダ○○"
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\管理者\保存するフォルダ○○\Book1.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
End Sub

ので、Filename:=の後の " から .xls" までを Range("A1") & ".xls" と変更する。

2については済みません。解りません。

1は、前回の回答で間違いありませんが、もう少し詳しく処理方法を書きます。

(1)そのBookを開き、ツール→マクロ→新しいマクロの登録を選択。
(2)ダイアログボックスを確認、マクロ名(今回はMacro1のまま)を入力し、OK。
(3)そのBookを適当な名前(今回はBook1)で保存し、マクロの記録を終了。
(4)ツール→マクロ→マクロを選択、マクロ名を選択し、編集ボタンを押す。
すると、下記のようなモジュールが現れる。
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2...続きを読む

QVBAでセル値からフォルダ名を取得するコードについて

Excel2016を使っております。

「データ」というフォルダ中に複数のフォルダが入っており、そのフォルダ名をG2セルに入力すると、入力したフォルダ名のフォルダに入っている全ファイルのデータをコピペするマクロを作りたいと思っています。
最初に「Const FolderPath As String = "D:\データ\" & Range("G2").Value」と書いて実行すると、「定義式が必要です。」とのコンパイルエラーが表示されて、valueに黄色のマーカーがついて動きが止まってしまいます。
変数の定義ができていないのかと思い「Dim FolderPath As String」と追記しても変わらずに止まってしまいます。

どのように書けばよいのか、ご教示願います。

Aベストアンサー

以下のように2行に分けて書いてください。
Dim FolderPath As String
FolderPath = "D:\データ\" & Range("G2").Value

1行にかいてダメな理由は省略します。

Qエクセル:シート名を手入力でなく、セル「A1」の文字を出したい。

いつもお世話になります。
エクセルのシート名についての質問です。
いつもはシート名を変えるとき、シートタブの上を右クリックして「変更」しています。

◆そこで、
(1) セル「A1」に入力されてある文字を自動で出す
(2) もしくはマクロボタンを押すと「A1」に入力されてあるものが「シート名」として変わる

というようにしたいのですが、その方法について教えてください。よろしくお願いいたします。

Aベストアンサー

こんにちは。


(1)の場合は、下記のコードを ThisWorkbook に記述してください。
どのワークシートでも機能します。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value
End Sub


(2)場合は、下記のコードを標準モジュールに記述しボタンにマクロ登録してください。
(すべてのシートにボタンを貼り付けるのは面倒でしょうから、ツールバーにボタンとして追加すると良いと思います。)

Public Sub SheetName()
ActiveSheet.Name = Range("A1").Value
End Sub

Qコンパイルエラー 修正候補:ステートメントの最後

EXCEL2000のマクロで
ActiveCell.FormulaR1C1 = "=VLOOKUP($H$4,INDIRECT(実績反映!$F$4&"!$A$3:$BP$65536"),28,0)"
という文を入れると、!$A$3の!の部分がハイライトされてタイトル記載のエラーが出ます。
実績反映!$F$4にはシート名(例えば200605)が入っています。
セルにVLOOKUPの式を入れると正常動作しますが、マクロに取り込むとエラーとなります。何故でしょうか?

Aベストアンサー

「$A$3:$BP$65536」の前後にある"を、2つ重ねて、
「""$A$3:$BP$65536""」のようにしてみてください。
VBAでは、"は文字列の囲みとしての意味を持つため、文字列の中身と
してこれを指定したい場合には、囲みの"と区別するために、特別に
2つ重ねて書く必要があります。

Q保存先のフォルダ名を指定したいとき

希望する事は
ファイルを保存するフォルダを指定し、
ファイル名(インプットボックスをつかって
変数として入力させたもの)をつけて保存したい。
フォルダは事前に作成してあるが
保存したい場所はそのときによってまちまちなので
保存するたびにフォルダを指定したい。


具体的には
C:\入力済みデータ\【○○】としたいのですが
この【○○】の部分を、そのときに応じて選択するにはどうすればいいでしょうか。

または、浅知恵で
Application.Dialogs(xlDialogSaveAs).Show arg1:="c:\"
というかたちでダイアログボックスを出すまでは出来たのですが
ファイル名は空欄になってしまいますよね。

InputBoxでファイル名を変数として入力させたものを
上のファイル名に入れることは可能ですか?

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

Aベストアンサー

これでできませんか?
まず条件どおり、C:\入力済みデータ の中にいくつかのフォルダを用意しました。
Excel 2003 を新規に立ち上げ、新規ワークブックに標準モジュールを挿入し、以下のコードを書き込んで実行しました。

Sub hoge()
Dim initPath As String
initPath = "C:\入力済みデータ"
Dim saveFilePath As String
saveFilePath = Application.GetSaveAsFilename(initPath, "Excel File (*.xls),*.xls")
If Not (saveFilePath = "False") Then
ThisWorkbook.SaveAs saveFilePath
End If
End Sub

"ファイル名を指定して保存" のダイアログが表示され、初期フォルダとして C:\入力済みデータ が開かれています。
ファイル名は何も指定されていません。
ダイアログの中には当然、先に作っておいたいくつかのサブフォルダが一覧表示されているので、ユーザーは
1) サブフォルダを選択する。
2) ファイル名を入力する。
3) [保存] ボタンをクリックする。
というアクションを行う。

私のところではダイアログ表示時の初期フォルダとして My Documents ではなく、きちんと C:\入力済みデータ が開かれましたよ。

これでできませんか?
まず条件どおり、C:\入力済みデータ の中にいくつかのフォルダを用意しました。
Excel 2003 を新規に立ち上げ、新規ワークブックに標準モジュールを挿入し、以下のコードを書き込んで実行しました。

Sub hoge()
Dim initPath As String
initPath = "C:\入力済みデータ"
Dim saveFilePath As String
saveFilePath = Application.GetSaveAsFilename(initPath, "Excel File (*.xls),*.xls")
If Not (saveFilePath = "False") Then
ThisWorkbook.SaveAs saveFilePath
End If
End Su...続きを読む

QExcelで指定したフォルダに保存するマクロ

Excel2003で、シートをコピーし別ファイルとして保存したいのですが
保存先のフォルダがネットワーク上にあります。
ファイル名は、指定したセルの値で保存されるようにします。
以下の記述でマクロ実行すると、シートは別ファイル(BOOK1)としてコピーされ
ます。
名前をつけて保存ダイアログが開きますが、そのときにマイドキュメントが開き
ます。

Private Sub CommandButton1_Click()
ActiveSheet.Select
ActiveSheet.Copy
Dim Sname As String, Fname As Variant, Folname As String
Folname = "ネットワーク上フォルダのフルパス"
Sname = Range("O46").Value
If Sname = "" Then Sname = ThisWorkbook.Name
Fname = Application.GetSaveAsFilename(InitialFileName:=Sname,
fileFilter:="Excel(*.xls), *.xls")
If Fname <> False Then ActiveWorkbook.SaveAs Fname
End Sub


そもそもネットワーク上のフォルダを指定することはできないのでしょうか?
マクロに関してはずぶの素人で、上記の記述は過去の質問などを参考に作成しま
したので
どこかに間違いがあるのかも知れませんが、間違いを特定することができません。

お手数おかけし申し訳ありませんが、ご教示のほどよろしくお願いします。


補足として、保存する際にダイアログを開きたい理由は以下の通りです。
・保存先誤り防止(作業者が多数いて、使用するPCも違うため)
・ファイル名誤り防止(同じファイル名が存在しないかどうか確認)

Excel2003で、シートをコピーし別ファイルとして保存したいのですが
保存先のフォルダがネットワーク上にあります。
ファイル名は、指定したセルの値で保存されるようにします。
以下の記述でマクロ実行すると、シートは別ファイル(BOOK1)としてコピーされ
ます。
名前をつけて保存ダイアログが開きますが、そのときにマイドキュメントが開き
ます。

Private Sub CommandButton1_Click()
ActiveSheet.Select
ActiveSheet.Copy
Dim Sname As String, Fname As Variant, Folname As String
Folname = "ネットワーク...続きを読む

Aベストアンサー

こちらでは、IP Address 指定だとファイル名が,"" で括られてしまいましたが
フォルダ名とファイル名が一緒くたになることはありませんでした。Excel2010
UNC名だとうまく行きました。

Sub てすと()
Dim Sname As String, Fname As Variant
Dim oFs As Object
Const FolName As String = "\\サーバー名\共有名\フォルダ名\"

Set oFs = CreateObject("Scripting.FileSystemObject")
If oFs.folderExists(FolName) = False Then
MsgBox FolName & " が見つかりません"
Set oFs = Nothing
Exit Sub
End If

ActiveSheet.Select
ActiveSheet.Copy
Sname = Range("O46").Value

If Sname = "" Then
Sname = ThisWorkbook.Name
End If

Fname = Application.GetSaveAsFilename(InitialFileName:=FolName & Sname, _
fileFilter:="Excel(*.xls), *.xls")

If Fname <> False Then
ActiveWorkbook.SaveAs Fname
End If
Set oFs = Nothing
End Sub

こちらでは、IP Address 指定だとファイル名が,"" で括られてしまいましたが
フォルダ名とファイル名が一緒くたになることはありませんでした。Excel2010
UNC名だとうまく行きました。

Sub てすと()
Dim Sname As String, Fname As Variant
Dim oFs As Object
Const FolName As String = "\\サーバー名\共有名\フォルダ名\"

Set oFs = CreateObject("Scripting.FileSystemObject")
If oFs.folderExists(FolName) = False Then
MsgBox FolName & " が見つかりません"
Set oFs = Nothing
Exit Sub
End...続きを読む


人気Q&Aランキング

おすすめ情報