File copy code using excel macro or VBA

Const cellfilename As String = "A"
Const celldesc As String = "B"


Public Sub doc()
Dim fso_w As New Scripting.FileSystemObject
Dim fso_r As New Scripting.FileSystemObject
Dim streamRead As TextStream
Dim strdesc, strHTML, strHTMLmain, strOther, str, strAO, strShip, strAdditionalShip, strTempdesc As String
Dim strShippingPackage, strweightlbs, strweightoz, strheight, strwidth As String
Dim i, intNoImage As Integer
Dim sDesktopPath As String
Set objWSHShell = CreateObject("WScript.Shell")
sDesktopPath = objWSHShell.SpecialFolders("Desktop")


intNoImage = 0

For i = 1 To 1 '17 To 116, 117 To 216, 217 to 716
'Do not create listings that do not have any images
strHTMLmain=””
Set b = fso_r.OpenTextFile(sDesktopPath + "\New Folder\doctorcloseout\eBayDescription\eBayDescription\" + Range(cellfilename & i).Value, ForReading)
strHTMLmain = b.ReadAll
Range(celldesc & i).Value = strHTMLmain
Next i
MsgBox "done!. No images= " + CStr(intNoImage)
End Sub