PDA

View Full Version : Can not copy data with VBA code



Susan1234
03-31-2021, 05:11 PM
With the help of the below code I am not able to copy the text in text files in excel cell if the text in file starts with "="
How can I modify the code?


Sub santa()
Dim r As Range, txt As String, msg As String
With Sheets("input")
For Each r In .Range("a2", .Range("a" & Rows.Count).End(xlUp))
If r <> "" Then
If Dir(r.Text) <> "" Then
txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(r.Text).ReadAll
r(, 2) = txt
r(, 3) = Join(Filter(Split(txt, vbNewLine), "VBA-2", True, 1), vbLf)
Else
msg = msg & vbLf & r.Text
End If
End If
Next
End With
If Len(msg) Then MsgBox "File not fouond" & msg
End Sub

DocAElstein
03-31-2021, 06:23 PM
Hello Susan1234
Welcome to ExcelFox

The problem is possibly that Excel is interpreting the = to mean you are pasting in a formula. Assuming the text after the = is not a valid formula, then Excel will then error.

A couple of ways to overcome that:

One way: You could test each txt entry for an = at the start, and then if there is a =, then change the format of the cell you will be writing into, to be text format:

Sub santaClaws() ' https://excelfox.com/forum/showthread.php/2741-Can-not-copy-data-with-VBA-code
Dim r As Range, txt As String, msg As String
With Sheets("input")
For Each r In .Range("a2", .Range("a" & Rows.Count).End(xlUp))
If r <> "" Then
If Dir(r.Text) <> "" Then
Let txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(r.Text).ReadAll
If Left$(txt, 1) = "=" Then Let r.Offset(0, 1).NumberFormat = "@"
Let r(, 2) = txt
If Left$(Join(Filter(Split(txt, vbNewLine), "VBA-2", True, 1), vbLf), 1) = "=" Then Let r.Offset(0, 2).NumberFormat = "@"
Let r(, 3) = Join(Filter(Split(txt, vbNewLine), "VBA-2", True, 1), vbLf)
Else
Let msg = msg & vbLf & r.Text
End If
End If
Next
End With
If Len(msg) Then MsgBox "File not fouond" & msg
End Sub

Alternatively you could just change all your writing-in range to text format

Sub Roodolf() ' https://excelfox.com/forum/showthread.php/2741-Can-not-copy-data-with-VBA-code
Dim r As Range, txt As String, msg As String
With Sheets("input")
Let .Range("B2:C" & .Range("a" & .Rows.Count).End(xlUp).Row & "").NumberFormat = "@"
For Each r In .Range("a2", .Range("a" & Rows.Count).End(xlUp))
If r <> "" Then
If Dir(r.Text) <> "" Then
Let txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(r.Text).ReadAll
Let r(, 2) = txt
Let r(, 3) = Join(Filter(Split(txt, vbNewLine), "VBA-2", True, 1), vbLf)
Else
Let msg = msg & vbLf & r.Text
End If
End If
Next
End With
If Len(msg) Then MsgBox "File not fouond" & msg
End Sub



If you don’t mind having an extra space at the beginning of some text, then you could simply add a space in front of any =
( That is the method I often use to prevent Excel seeing an = as the first character )

Sub Vixen() '
Dim r As Range, txt As String, msg As String
With Sheets("input")
For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
If r <> "" Then
If Dir(r.Text) <> "" Then
Let txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(r.Text).ReadAll
If Left$(txt, 1) = "=" Then Let txt = " " & txt
Let r(, 2) = txt
Dim r3 As String: Let r3 = Join(Filter(Split(txt, vbNewLine), "VBA-2", True, 1), vbLf)
If Left$(r3, 1) = "=" Then Let r3 = " " & r3
Let r(, 3) = r3
Else
Let msg = msg & vbLf & r.Text
End If
End If
Next
End With
If Len(msg) Then MsgBox "File not fouond" & msg
End Sub


Another option could be to simply remove any first character = in the text strings

Sub Blitzen() '
Dim r As Range, txt As String, msg As String
With Sheets("input")
For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
If r <> "" Then
If Dir(r.Text) <> "" Then
Let txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(r.Text).ReadAll
If Left$(txt, 1) = "=" Then Let txt = Replace(txt, "=", "", 1, -1, vbBinaryCompare)
Let r(, 2) = txt
Dim r3 As String: Let r3 = Join(Filter(Split(txt, vbNewLine), "VBA-2", True, 1), vbLf)
If Left$(r3, 1) = "=" Then Let r3 = Replace(r3, "=", "", 1, -1, vbBinaryCompare)
Let r(, 3) = r3
Else
Let msg = msg & vbLf & r.Text
End If
End If
Next
End With
If Len(msg) Then MsgBox "File not fouond" & msg
End Sub




I tested on the uploaded files… ( you will need to change the full path in cell A1 to suit where you have the text file)

Alan

DocAElstein
09-27-2022, 03:19 PM
@ susan santa 12345 et al

You continue to post short badly explained questions, and either ignore or don’t understand the various things I have said to you.

My best guess is that you are either
_ a Bot,
_ a total idiot,
_ just trying your luck at getting Homework questions answered quickly
_ just trying your luck at answering someone else’s questions and have no idea or interest in them yourself
_ deliberately trying to be a pain in the arse.

I will probably delete, close , ban you, or some combination in a few days to tidy the place up a bit
Maybe try posting at excelforum.com or mrexcel.com, (again)

Alan