VBA excel copied to notepad

tonnesso

New Member
Joined
Jan 20, 2009
Messages
1
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!
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
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:
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.
 
Upvote 0
Another example. Add the reference commented in GetClipboard().
Code:
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
 
Upvote 0

Forum statistics

Threads
1,215,879
Messages
6,127,515
Members
449,385
Latest member
KMGLarson

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top