• 締切済み

ExcelVBAで、隠しフォルダにあるファイルに書き込みする方法

お世話になります。 ExcelVBAで、ネットワーク上の隠しフォルダ(....$で開く ことができる場所のことです)に、テキストファイルの書き 込みをしたいのですが、outputのところで『パス名が無効です』と 表示され、書き込みを行うことができません。 inputで読み込みを行う際には問題なくできるのですが、どうして 書き込みはできないのでしょうか。 原因と対処法を教えてください。 下記が、その例です。 Public Function readText(ByVal stFileName) As String Dim ch1 As Long Dim textline As String Dim stAllText As String readText = "" '空いているファイル番号を取得します ch1 = FreeFile Close #ch1 'FileNamePath のファイルをオープンします Open stFileName For Input As #ch1 'エラーが発生したらファイルを閉じます On Error GoTo Err_readText stAllText = "" '最初に1行だけ読み込む Line Input #ch1, textline stAllText = textline Do While Not EOF(ch1) 'ファイルの終端かどうかを確認します。 '1行読み込みます Line Input #ch1, textline ' 文字列を連結する。 stAllText = stAllText & vbCrLf & textline Loop Close #ch1 readText = stAllText Exit Function Err_readText: Close #ch1 MsgBox Err.Description, vbExclamation, sysName End Function ↑↑↑readは成功します。 Public Function writeText(ByVal stFileName, ByVal stBuff) As Boolean On Error GoTo ErrMsg ' ファイルポインタ Dim n As Long n = FreeFile Open stFileName For Output As #n  ← ここでエラーになる。 Print #n, stBuff Close #n writeText = True Exit Function ErrMsg: ' エラー時処理 MsgBox Err.Description, vbCritical, sysName writeText = False End Function ↑↑↑書き込みではエラーになります。 以上、よろしくお願いいたします。

みんなの回答

回答No.1

読み込みは可能だが、書き込みは不可能ということなので、 そのディレクトリは全てのユーザに対して変更を許可しているのか確認してみてはどうでしょうか?

tatapata
質問者

お礼

bluecampusさん、ありがとうございました。 おっしゃる通り、権限が決められているため保存できないようでした。 大変申し訳ありませんでした。 また何かありましたら、よろしくお願いいたします。

関連するQ&A

  • CSVの読み込み処理について

    こんばんわです。 エクセルのVBAをつかってCSV形式のファイルデーターを読み込みように某サイトを参考に作成しました。 確かに読み込む事が出来たのですが、数値も文字列扱いになってしまいます。 数値処理する方法があるのでしょうか? Sub CSV_Read2() Dim FileType, Prompt As String Dim FileNamePath As Variant Dim textline, csvline() As String Dim Rowcnt, ColumNum As Integer Dim ch1 As Long FileType = "CSV ファイル (*.csv),*.csv" Prompt = "CSV File を選択してください" '操作したいファイルのパスを取得します FileNamePath = SelectFileNamePath(FileType, Prompt) If FileNamePath = False Then 'キャンセルボタンが押された End End If '空いているファイル番号を取得します ch1 = FreeFile 'FileNamePath のファイルをオープンします Open FileNamePath For Input As #ch1 'エラーが発生したらファイルを閉じます 'CSVのファイルは1行の項目数が正確に合っていないと読めないのですが、 '色々なCSVがあるようなので入れておきます On Error GoTo CloseFile '表の行番号の初期化 1行目から読み込んだデータを入力します Rowcnt = 1 Do While Not EOF(ch1) 'ファイルの終端かどうかを確認します。 '1行読み込みます Line Input #ch1, textline 'ダブルクォーテーションを削除します 'カンマ+ダブルクォーテーションで区切られている CSV ファイルなどは '適時追加してください textline = Replace(textline, """", "") 'カンマで分離します csvline() = Split(textline, ",") '配列渡しでセルに代入 Range(Cells(Rowcnt, 1), Cells(Rowcnt, UBound(csvline()) + 1)) = csvline() Rowcnt = Rowcnt + 1 Loop CloseFile: 'ファイルを閉じます Close #ch1 End Sub Function SelectFileNamePath(FileType, Prompt) As Variant SelectFileNamePath = Application.GetOpenFilename(FileType, , Prompt) End Function Function GetItemNum(FileNamePath) As Integer Dim ch1 As Long Dim textline As String '空いているファイル番号を取得します ch1 = FreeFile 'FileNamePath のファイルをオープンします Open FileNamePath For Input As #ch1 Line Input #ch1, textline '1行だけ読み込みます。 Close #ch1 GetItemNum = 1 '1行中のカンマの数を数えます Do GetItemNum = GetItemNum + 1 textline = Mid(textline, InStr(textline, ",") + 1) Loop Until InStr(textline, ",") = 0 End Function

  • \記号が入った数値の処理について(VBA)

    はじめまして。 excel2013でcsvの読み込みをVBAで自動化させようとしています。 基となるCSVファイルに\記号が含まれておりファイルを読み込むと文字列として読まれてしまいまい、エラーインジケータが表示されます。 文字と読み込まれているので計算もできないでいます。 数値に置き換える方法として考えられる事はないでしょうか? ご教授お願いいたします。 ------------------------------- ソース Sub Read() Dim FileType, Prompt As String Dim FileNamePath As Variant Dim csvline() As String Dim i, Rowcnt, ColumNum As Integer Dim ch1 As Long FileType = "CSV ファイル (*.csv),*.csv" Prompt = "CSV File を選択してください" '操作したいファイルのパスを取得します FileNamePath = SelectFileNamePath(FileType, Prompt) If FileNamePath = False Then 'キャンセルボタンが押された End End If '1行あたりの項目数を取得します ColumNum = GetItemNum(FileNamePath) 'csvlineを1行あたりの項目数で再割り当てます ReDim csvline(1 To ColumNum) '空いているファイル番号を取得します ch1 = FreeFile 'FileNamePath のファイルをオープンします Open FileNamePath For Input As #ch1 'エラーが発生したらファイルを閉じます 'CSVのファイルは1行の項目数が正確に合っていないと読めないのですが、 '色々なCSVがあるようなので入れておきます On Error GoTo CloseFile '表の行番号の初期化 1行目から読み込んだデータを入力します Rowcnt = 1 Do While Not EOF(ch1) 'ファイルの終端かどうかを確認します。 For i = 1 To ColumNum Input #ch1, csvline(i) '1行の項目数だけ読み込みます Next '配列渡しでセルに代入 この方が早い Range(Cells(Rowcnt, 1), Cells(Rowcnt, ColumNum)) = csvline() Rowcnt = Rowcnt + 1 Loop CloseFile: 'ファイルを閉じます Close #ch1 End Sub Function GetItemNum(FileNamePath) As Integer Dim ch1 As Long Dim textline As String '空いているファイル番号を取得します ch1 = FreeFile 'FileNamePath のファイルをオープンします Open FileNamePath For Input As #ch1 Line Input #ch1, textline '1行だけ読み込みます。 Close #ch1 GetItemNum = 1 '1行中のカンマの数を数えます Do GetItemNum = GetItemNum + 1 textline = Mid(textline, InStr(textline, ",") + 1) Loop Until InStr(textline, ",") = 0 End Function Function SelectFileNamePath(FileType, Prompt) As Variant SelectFileNamePath = Application.GetOpenFilename(FileType, , Prompt) End Function ----------------------- CSVファイル \101,\101,\101

  • access VBAでのファイル読み込みとその保存方法

    昨日も質問させていただいたVBA初心者です。 いろいろ調べましたが解決しなかったので、 またまた質問させていただきます。 ファイルを読み込んで、それを別ファイルに保存したいのですが、 下記ですと、1行のみ保存されるだけでした。 この方法ですと、すべて保存されるはずと書かれていたのですが。 全くどこが悪いのか分かりません、よろしくお願いします。 Private Sub cmd_Click() On Error GoTo Err_cmd_Click Dim ReadFileName As String Dim Contents As String Dim WriteFileName As String ReadFileName = "P:\dl_engine\logs1\service\20020223" ' ファイルを読み込む Open ReadFileName For Input As #1 Input #1, Contents Close #1 WriteFileName = "C:\Contents\data\Melody.csv" ' ファイルに保存 Open WriteFileName For Output As #2 Write #2, Contents Close #2 '正常終了 Exit_cmd_Click: Exit Sub 'エラー処理 Err_cmd_Click: Beep Select Case Err.Number Case Else MsgBox Err.Number & ":" & Err.Description End Select Resume Next End Sub

  • テキストファイルの閉じ方について

    いつもお世話になります。 環境はXPを使用しています。 VBAでセルに設定してあるハイパーリンクを開くと テキストファイルが開くようにしてあります。 このテキストファイルを閉じようとするのですが、 閉じません。 ちなみにソースは以下の通りです。 intFileNum = FreeFile Open strFileName For Input As intFileNum i = 1 Do While Not EOF(intFileNum) Input #intFileNum, TextLine Cells(i, 1) = TextLine i = i + 1 Loop Close #intFileNum 最後のCloseで閉じないのはなぜですか? 初めてテキストファイルを操作するのでよくわかりません。 よろしくお願いします。

  • VBAでCSVファイルを読み込もうとしていますが、

    VBAでCSVファイルを読み込もうとしていますが、 「ファイルが見つかりません」とエラーが表示されます。 どのように対処していいのかわかりません。 教えてくください。 Sub readCsv() Dim csvFile As String Dim ch As Integer Dim csvStr As String Dim str() As String Dim i As Integer Set ShellApp = CreateObject("Shell.Application") Set oFolder = ShellApp.BrowseForFolder(0, "フォルダ選択", 1) targetFolder = oFolder.Items.Item.Path Set fso = CreateObject("Scripting.FileSystemObject") Set fileList = fso.GetFolder(targetFolder).Files For Each file In fileList csvFile = file.Name ch = FreeFile Open csvFile For Input As #ch i = 1 Do While Not EOF(1) Line Input #ch, csvStr Close #ch str = Split(csvStr, ",") Range(Cells(i, 1), Cells(i, UBound(str) + 1)) = str i = i + 1 Loop Next End Sub

  • ADODB.Streamを使って新規にファイルを作

    ADODB.Streamを使って新規にファイルを作成することは可能ですか? --------------------------------------------- Sub test1() Dim n As Long n = FreeFile Open "C:\sample.html" For Output As #n Print #n, "テキスト" Close #n End Sub これで、新規にhtmlファイルを作れるのですが --------------------------------------------- Sub test2() Dim st As Object Dim Sample As String Set st = CreateObject("ADODB.Stream") オブジェクトに保存するデータの種類を文字列型に指定する st.Type = adTypeText 文字列型のオブジェクトの文字コードを指定する st.Charset = "UTF-8" st.Open 'オブジェクトのインスタンスを作成 st.WriteText Sample, adWriteLine 'ココでエラー オブジェクトの内容をファイルに保存 st.SaveToFile ("c:\sample.html"), adSaveCreateOverWrite オブジェクトを閉じる st.Close メモリからオブジェクトを削除する Set st = Nothing End Sub --------------------------------------------- この方式で新規にファイルを生成して保存することは可能ですか? 該当部分でエラーが発生します。

  • CSVファイルの読み込みVBA作成について

    初めまして。 色々インターネット等で検索して作成してみたのですが、 ここから先のプログラムが組めないので、 やり方を教えて頂けますと幸いです。 おそらくIf Elseで場合訳すると思うのですが、 上手くできてません。 下記、プログラムの概要です。 (1)フォルダを指定し、そのフォルダにある全てのCSVファイルを読み込む。 (2)CSVファイルを読み込む際には、「*.csv」の「*」部分をワークシート名とし、CSVファイルの内容をワークシートに書き込む。 例)「test.csv」の場合、ワークシート名は「test」になります。 (3)既にブックにワークシート名がある場合は上書き処理を行い、ない場合は新規に作成する。 例)既に「test」ワークシートがある場合は、内容の上書きを行います。 (4)ワークシートを追加する際は、今あるワークシートの最後に追加する。 下記に現在作ったプログラムを記載します --------------------------------- Sub csvRead() Dim FoldPath As String Dim f Dim ch1 As Long Dim r As Long Dim textLine As String Dim csvLine() As String Dim i As Long Dim FSO Dim folderSelect As Object Set folderSelect = CreateObject("Shell.Application"). _ BrowseForFolder(0, "フォルダを選択してください", 0) If Not folderSelect Is Nothing Then FoldPath = folderSelect.Self.Path 'フォルダ選択 End If Set FSO = CreateObject("Scripting.FileSystemObject") i = Worksheets.Count '現在のワークシート数を格納 For Each f In FSO.GetFolder(FoldPath).Files If StrConv(Right(f.Path, 4), vbLowerCase) = ".csv" Then ch1 = FreeFile Open f.Path For Input As #ch1 r = 1 Worksheets.Add after:=Worksheets(i) With ActiveSheet .Name = Left(f.Name, Len(f.Name) - 4) Do While Not EOF(ch1) Line Input #ch1, textLine If textLine <> "" Then csvLine() = Split(textLine, ",") .Range(Cells(r, 1), Cells(r, UBound(csvLine()) + 1)) = csvLine() End If r = r + 1 Loop End With i = i + 1 Close #ch1 End If Next End Sub

  • accessVBAで特定の文字列を削除

    以前頼んで作ってもらったVBAを少し改造しようと思っていますが、上手くいきませんので質問します。よろしくお願いします。 csvファイルを分割するVBAを作ってもらいました。 1001,a12345678 1001,b15467863546789 1001,b25463254875698 1001,c23564879 1005,a23456753 1005,b25647565823653 1005,c26546875 1007,a23456789 1007,b23659856325632 1007,b46785215468523 1007,c12546873 というcsvファイルを 1001.csvというファイルで中身は 1001,a12345678 1001,b15467863546789 1001,b25463254875698 1001,c23564879 と 1005.csvというファイルで中身は、 1005,a23456753 1005,b25647565823653 1005,c26546875 と 1007.csvというファイルで中身は、 1007,a23456789 1007,b23659856325632 1007,b46785215468523 1007,c12546873 の3つのcsvファイルに分けます。 今回は仕様変更で、 1001.csvというファイルで中身は a12345678 b15467863546789 b25463254875698 c23564879 と 1005.csvというファイルで中身は、 a23456753 b25647565823653 c26546875 と 1007.csvというファイルで中身は、 a23456789 b23659856325632 b46785215468523 c12546873 の3つに分けなくてはならなくなりました。 今使っているVBAは Private Sub DOQUERY_Click() Dim IN_FNO As Integer Dim OUT_FNO As Integer Dim BREAK_OLD As String Dim BREAK_NEW As String Dim HEADLINE As String Dim TEXTLINE As String Dim ARY() As String Dim OUTNAME As String Dim ARYNAME() As String Dim CNT As Integer Dim MSG As String '============================================ On Error GoTo err If IsNull(InputFile) Or IsNull(OutputFile) Then Exit Sub End If If InputFile = "" Or OutputFile = "" Then MsgBox "ファイル名が正しく指定されていません。", vbCritical Exit Sub End If ラベル5.Visible = True DoEvents '読込みCSV OPEN IN_FNO = FreeFile Open InputFile For Input As #IN_FNO '見出し読込み Line Input #IN_FNO, HEADLINE$ '1レコード目読込み Line Input #IN_FNO, TEXTLINE$ '発注番号 ARY() = Split(TEXTLINE$, ",") BREAK_NEW = Replace(ARY(0), """", "") BREAK_OLD = BREAK_NEW '出力CSVファイル名作成 OUTNAME = OutputFile & BREAK_NEW & ".csv" '出力CSVファイル名保存 CNT = 1 ReDim Preserve ARYNAME(CNT) ARYNAME(CNT) = OUTNAME '出力CSV OPEN OUT_FNO = FreeFile Open OUTNAME For Output As #OUT_FNO '見出し書込み Print #IN_FNO, HEADLINE$ '1レコード目書込み Print #IN_FNO, TEXTLINE$ Do While Not EOF(IN_FNO) '次レコード目読込み Line Input #IN_FNO, TEXTLINE$ '発注番号 ARY() = Split(TEXTLINE$, ",") BREAK_NEW = Replace(ARY(0), """", "") '発注番号が変わったとき新しいCSVを開く If BREAK_OLD <> BREAK_NEW Then CNT = CNT + 1 BREAK_OLD = BREAK_NEW '旧書込みCSVをクローズ Close #OUT_FNO '新出力CSVファイル名作成 OUTNAME = OutputFile & BREAK_NEW & ".csv" '新出力CSVファイル名保存 ReDim Preserve ARYNAME(CNT) ARYNAME(CNT) = OUTNAME '新出力CSV OPEN OUT_FNO = FreeFile Open OUTNAME For Output As #OUT_FNO End If '次レコード書込み Print #OUT_FNO, TEXTLINE$ Loop '出力CSVクローズ Close #OUT_FNO '入力CSVクローズ Close #IN_FNO '出力したCSV名称一覧 Dim I As Integer For I = 1 To UBound(ARYNAME()) MSG = MSG & ARYNAME(I) & vbCrLf Next MsgBox CNT & "個のファイルに分割しました。" & vbCrLf + vbCrLf & MSG, vbInformation, "CSV分割" ラベル5.Visible = False Exit Sub err: MsgBox err.Description, vbCritical, "エラー" ラベル5.Visible = False End Sub です。 ファイル名がBREAK_NEWでそれを消せればいいと思うのですが・・・ 以上長くなりましたが、よろしくお願いします。

  • 指定番目の文字を読む込む・・・超初心者

    遅ればせながらVISTAを搭載したノートブックを買って遊び始めました。 VB2008Expressをダウンロードして最初のプロジェクトに挑戦中。 が、情けないことに最初から躓いて立ち往生中です。 <ファイルから指定番目の文字を読む込む関数の作成要領> ' --------------------------- ' FileGetChar VB6.0 Version ' --------------------------- Public Function FileGetChar(ByVal f As String, ByVal r As Long) As String   Dim n As Integer   Dim c As String * 1      n = FreeFile()   Open f For Random As #n Len = 1   Get #n, r, c   Close #n   FileGetChar = c End Function ' ----------------------------- ' FileGetChar VB 2008 Version ' ----------------------------- Public Function FileGetChar(ByVal f As String, ByVal p As Short) As String   Return (GetChar(My.Computer.FileSystem.ReadAllText(f), p)) End Function VB 2008バージョンの問題点は、その都度に全てのテキストを呼び込んでいることです。 質問は、この難点を克服する方法についてです。 MSDNライプラリを読めばとは思いますが・・・。 聞いた方が早いかなと思って質問します。 宜しくお願いします。

  • ExcelVBAでフォームのタイトルバーで右クリックした場合などに閉じるボタンが有効化されないようにするコード

    Excelのプログラムで、最小化ボタンを有効にし、閉じるボタンを無効にする質問をしたんですが、うまくいったと思ったのですがフォームが開き、タイトルバーで右クリックした場合などは閉じるボタンが有効化されてしまうのでこれを無効のままにするコードを教えてください。 作ったプログラムは以下の通りです。 標準モジュール Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function DrawMenuBar Lib "user32" _ (ByVal hWnd As Long) As Long Public Declare Function GetSystemMenu Lib "user32.dll" _ (ByVal hWnd As Long, ByVal bRevert As Long) As Long Public Declare Function EnableMenuItem Lib "user32" _ (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long Public Const MF_DISABLED = &H2& Public Const GWL_STYLE = (-16) Public Const WS_MINIMIZEBOX = &H20000 Public Const MF_BYCOMMAND = &H0& Public Const SC_CLOSE = &HF060& Dim hSysMenu As Long UserForm_Initializeプロシージャ Dim fRet As Long Dim hWnd As Long Dim fStyle As Long hWnd = FindWindow("ThunderDFrame", "UserForm1") fStyle = GetWindowLong(hWnd, GWL_STYLE) fStyle = (fStyle Or WS_THICKFRAME Or WS_MINIMIZEBOX) fRet = SetWindowLong(hWnd, GWL_STYLE, fStyle) hSysMenu = GetSystemMenu(hWnd, 0) EnableMenuItem hSysMenu, SC_CLOSE, MF_BYCOMMAND Or MF_DISABLED fRet = DrawMenuBar(hWnd) 回答よろしくお願いします。

専門家に質問してみよう