Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7862 / 13644 ツリー ←次へ | 前へ→

【36405】ありがとうございます あや 06/3/30(木) 16:24 お礼[未読]
【36409】Re:ありがとうございます Kein 06/3/30(木) 16:50 回答[未読]

【36405】ありがとうございます
お礼  あや  - 06/3/30(木) 16:24 -

引用なし
パスワード
   ありがとうございます。
下記方法でできました。
(FunctionのStringFromRangeは記述済)
単純なことでした。
しかし、いろいろな方法があるんですね。参考になりました。
また、わからないことがありましたら質問させていただきます。
よろしくお願いいたします。
-------------------------------------------------------------------
Public Sub データへ保存()
  Dim strbuff, folder, filename_dat As String
  folder = "..\..\cgi-bin\kakunin\data"
  filename_dat = "\test.txt"
  
  On Error GoTo select_err
  
   Worksheets("temp").Select
   Range("A1").Select
   Range(Selection, Selection.End(xlDown)).Select
   Range(Selection, Selection.End(xlToRight)).Select
   strbuff = StringFromRange(Selection)
        
   Dim fso As Object
   Set fso = CreateObject("Scripting.FileSystemObject")
   If fso.fileExists(filename_dat) = True Then
     Call fso.Copyfile(filename_dat, folder & "\test_bk.txt", True)
   End If
    
   Dim flowfile As Object
   Set flowfile = fso.CreateTextFile(folder & "\test.txt", True)
   flowfile.Write strbuff
   flowfile.Close
   MsgBox ("test.txtを" & vbCr & folder & vbCr & "に保存しました。")
   Exit Sub
select_err:
  MsgBox ("エラーです。ファイルに保存できません。")
  Exit Sub
End Sub

【36409】Re:ありがとうございます
回答  Kein  - 06/3/30(木) 16:50 -

引用なし
パスワード
  
>シート内の文字をtxtファイルで2つ上のフォルダに保存
ということだったのね・・見落としてました。
解決済みのようですが、いちおうその線で私のサンプルも提示しておきます。

Sub Make_MyTextFile()
  Dim x As Long, y As Long
  Dim MyR As Range, C As Range
  Dim NewPh As String, NewN As String
 
  With ActiveWorkbook
   x = InStrRev(.Path, "\", -1)
   y = InStrRev(.Path, "\", x - 1)
   NewPh = Left$(.Path, y)
  End With
  Do
   NewN = ""
   NewN = inputBox("作成するテキストファイルの名前を" & _
   vbLf & "拡張子なしで入力して下さい")
   NewN = NewPh & NewN & ".txt"
   If Dir(NewN) <> "" Then
     MsgBox "その名前のファイルは既に存在します", 48
   End If
  Loop While Dir(NewN) <> ""
  With Sheets("temp")
   Set MyR = .Range("A1", .Range("A65536").End(xlUp))
  End With
  Open NewN For OutPut Access Write As #1
  For Each C In MyR
   Print #1, C.Text
  Next
  Close #1: Set MyR = Nothing
  MsgBox NewN & vbLf & "を作成しました", 64
End Sub 

7862 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free