VBA excel copied to notepad

[tonnesso]

Hi,
I'm farely new at VBA and I need could need some help.

I'm trying to make a macro where I can copy excel cells to notepad, example:

I want the data in A1 copied in a notepadfile and be named with data in B1, then A2 copied in a notepadfile and be named with data in B2, then A3 copied in a notepadfile and be named with data in B3........ and so on.

I've tried with this macro put cant get it to work. it allways copies A1:A411 into B1 and thats it.

Sub ExportToNotepad()
Dim rngEachCell As Range


For Each rngEachCell In Sheets("hex").Range("A1:A411").Cells

WriteRangeToTextFile Range("B1:B411"), rngEachCell.Value, vbTab
Shell "notepad.exe " & rngEachCell.Value, vbMaximizedFocus

Next rngEachCell

End Sub


Sub WriteRangeToTextFile(Source As Range, Path As String, Delimiter As String)
Dim oFSO As Object
Dim oFSTS As Object
Dim lngRow As Long, lngCol As Long


Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFSTS = oFSO.CreateTextFile(Path, True)

For lngRow = 1 To Source.Rows.Count

For lngCol = 1 To Source.Columns.Count

If lngCol = Source.Columns.Count Then
oFSTS.Write Source.Cells(lngRow, lngCol).Text & vbCrLf
Else
oFSTS.Write Source.Cells(lngRow, lngCol).Text & Delimiter
End If

Next lngCol

Next lngRow

oFSTS.Close

Set oFSTS = Nothing
Set oFSO = Nothing

End Sub

Does the filenames in B1:B411 have to have the path where i want it saved?

Hope somebody can help me, thanx!

 

[xenou]

The createtextfile method does require the full path where you want to save the text file (at least, that's best so you can be sure you know where you saved it):


UNTESTED SAMPLE CODE:

For x = 1 to 411
   set oFSTS = oFS.CreateTextFile("C:\MyFolder\" & Range("A" & x).value & ".txt")
   oFSTS.WriteLine(Range("A" & x).Value & "," & Range("B" & x).Value
   oFSTS.Close
Next x

1)
the WriteLine method instead of Write will add the end of line character. I've assumed a comma here between the two values.

2)
Since you want each saved I think you have to open and save each file separately? You'll end up with 411 text files saved. Is that what you want?

3)
There are more arguments for the CreateTextFile method - not sure if that's important (maybe the defaults will work for you here).

4) Do you really need Notepad? If you save the text files, isn't that enough? The FSO object does all that for you invisibly and effectively.

 

[Kenneth Hobson]

Another example. Add the reference commented in GetClipboard().

Sub t()
    Dim rc As Variant
    Dim s As String, s2 As String
     
    s = ActiveWorkbook.Path & "\Fruits.txt"
    
    [A1] = "Fruit"
    [A2] = "Apple"
    [A3] = "Grape"
    [A4] = "Orange"
    [B1] = "Color"
    [B2] = "Red/Golden"
    [B3] = "Red/Green"
    [B4] = "Orange"
    
    Range("A1:B4").Copy
    s2 = Replace(getClipboard(), vbTab, ",")
    Application.CutCopyMode = False
    MakeTXTFile s, s2
    
    rc = Shell("notepad " & """" & s & """", vbNormalFocus)
    'Kill s
End Sub

Sub MakeTXTFile(filePath As String, str As String)
    Dim hFile As Integer
    If Dir(FolderPart(filePath), vbDirectory) = "" Then
         MsgBox filePath, vbCritical, "Missing Folder"
        Exit Sub
    End If
     
    hFile = FreeFile
    Open filePath For Output As #hFile
    If str <> "" Then Print #hFile, str
    Close hFile
End Sub
 
 Function FolderPart(sPath As String) As String
    FolderPart = Left(sPath, InStrRev(sPath, "\"))
End Function

Function getClipboard()
'Add Reference:   'Reference: Microsoft Forms xx Object
    Dim MyData As DataObject
     
    On Error Resume Next
    Set MyData = New DataObject
    MyData.GetFromClipboard
    getClipboard = MyData.GetText
End Function

 

[Joe Was]

You may also want to look at this post:

http://www.mrexcel.com/forum/showthread.php?t=203381