CODEWITHSUNDEEP
excelvbacopyrange
Vihar
Vihar

Reputation: 69

Copy used range to text file

I want to:

I have:

Sub CreateAfile()

Dim pth As String
pth = ThisWorkbook.path
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Dim a As Object
Set a = fs.CreateTextFile(pth & "\Kommentar.txt", True)
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Kommentar")

Dim rng As Range
Set rng = sh.UsedRange
a.WriteLine (rng)
a.Close

End Sub

I get

run-time error '13' Mismatch

In line a.WriteLine (rng) the function doesn't accept range to be written.

Upvotes: 3

Views: 19319

Answers (4)

DSlomer64
DSlomer64

Reputation: 4283

@xwhitelight gives a good outline. Thanks. But I needed to supply details to myself to accomplish my own task and thought I'd share.

First, a Reference to Microsoft Scripting Runtime and another to Microsoft Forms 2.0 Object Library are required.

The coding details I added to produce an output file follow.

Note that textfilename is the fully-qualified name of the output file that contains the spreadsheet range.

Note that textfilename is opened in the last line of the sub, which isn't necessary, but it's reassuring to SEE what the file contains. Of course, the MsgBox is also unnecessary.

Sub turnRangeIntoTextFile(rg As Range, textfilename As String)

  Dim textFile as TextStream

  Dim fs As FileSystemObject
  Dim myData As DataObject

  Set myData = New DataObject
  Set fs = CreateObject("Scripting.FileSystemObject")

  rg.Copy
  myData.GetFromClipboard
  MsgBox myData.GetText ' reassurance (see what I got)

  Set textFile = fs.CreateTextFile(textfilename, True)
  textFile.WriteLine (myData.GetText)
  textFile.Close

  CreateObject("Shell.Application").Open (textfilename)

End Sub

Upvotes: 0

xwhitelight
xwhitelight

Reputation: 1579

Let's say yourRange is the range you want to copy as string.

  1. Use yourRange. Copy to copy it.
  2. After you copied it, Excel saves the text value to the clipboard. Cells in a row separated by tabs, and every row ends with an enter. You can use DataObject's GetFromClipboard and GetText method to save it to a string variable.
  3. Use CreateTextFile to save it to a file.

Upvotes: 0

Eddie
Eddie

Reputation: 621

Not sure you can do that. I believe you would have to write it out line by line.

Here is an alternative option.
Rather than use the FSO, you could just try saving the sheet as a .txt file. Here's some sample code. Credit should goto http://goo.gl/mEHVx

Option Explicit

'Copy the contents of a worksheet, and save it as a new workbook as a .txt file
Sub Kommentar_Tab()
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wbDest As Workbook
Dim fName As String

'References
Set wbSource = ActiveWorkbook
Set wsSource = ThisWorkbook.Sheets("Kommentar")
Set wbDest = Workbooks.Add

'Copy range on original sheet
'Using usedrange can be risky and may return the wrong result.
wsSource.UsedRange.Copy

'Save in new workbook
wbDest.Worksheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

'Get file name and location
fName = ThisWorkbook.Path & "\Kommentar.txt"

'Save new tab delimited file
wbDest.SaveAs fName, xlText

wbDest.Close SaveChanges:=True

End Sub

Upvotes: 2

Olle Sjögren
Olle Sjögren

Reputation: 5385

Since your range is probably made up of several cells, you have to loop through them to get all the text into a string variable. If you use a Variant variable you can copy the values and automatically get an array with the correct dimensions of all the data in the cells, then loop it and copy the text:

Function GetTextFromRangeText(ByVal poRange As Range) As String
    Dim vRange As Variant
    Dim sRet As String
    Dim i As Integer
    Dim j As Integer

    If Not poRange Is Nothing Then

        vRange = poRange

        For i = LBound(vRange) To UBound(vRange)
            For j = LBound(vRange, 2) To UBound(vRange, 2)
                sRet = sRet & vRange(i, j)
            Next j
            sRet = sRet & vbCrLf
        Next i
    End If

    GetTextFromRangeText = sRet
End Function

Call the function in your code by replacing the a.WriteLine (rng) line with the following:

Dim sRange As String
sRange = GetTextFromRangeText(rng)
Call a.WriteLine(sRange)

Upvotes: 5

Related Questions