Skipping files which exist as named cell values - 1004 application error

[philip.widdowson]

Hi all,

I'm not very able with complex levels of VB or in this case VBA,
However, using some stuff other people have posted on the internet
I've assembled my own macro to run whenever the workbook is opened.

The idea is that opens a folder, then for each file in the folder it
adds them all to a line in Excel. The files are txt's, which are comma
seperated and this insert works perfectly.

The file name is added into cell A1 and the extension is trimed off
and this value is assign as the Cell Name.

Whenever the script runs, it adds. If you run the script again without
changing any files in the target seek folder, it doesn't error, but
also doesn't update the workbook (I assume that it's doing as it
should)

However, when you add a new file into the folder, it generates an
Error on the following line (in the second section)

ActiveWorkbook.Names.Add Name:=CNDefine,
RefersToR1C1:=NameInjectRow

Could anyone shed any light onto why this happens to generate a 1004
runtime error - Application-defined or Object-defined error?

I've tried myself, hence why some bits are wierd and the such like,
but I've not managed to work it out.

My coding is properly really rubbish but it's only I who will use
this.



Public Sub Workbook_Open()

Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer

Application.ScreenUpdating = False

Range("B1").Select

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oWSH = CreateObject("WScript.Network")
If oFSO.DriveExists("I:") Then oWSH.RemoveNetworkDrive "I:", True
oWSH.MapNetworkDrive "I:", "\\lucid\specifications"

Set TargetSeekFolder = oFSO.GetFolder("I:\")
Set FilesInTSF = TargetSeekFolder.Files

If Range("B1").Value = "" Then

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row

For Each File In FilesInTSF

CNArr = Split(File.Name, ".")
CNDefine = CNArr(0)

FName = "I:\" & File.Name
Cells(RowNdx, 1).Value = CNDefine
'ActiveCell.Name = CNDefine
ActiveWorkbook.Names.Add Name:=CNDefine,
RefersToR1C1:="=TextInject!$A$" & RowNdx

Open FName For Input Access Read As #1

While Not EOF(1)

Line Input #1, WholeLine

If Right(WholeLine, 1) <> ", " Then
WholeLine = WholeLine & ", "
End If

ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, ", ")

While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, ", ")
Wend

RowNdx = RowNdx + 1

Wend

On Error GoTo 0

Application.ScreenUpdating = True

Close #1

Next

Else

Range("B1").End(xlDown).Offset(1, 0).Activate

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row

For Each File In FilesInTSF

CNArr = Split(File.Name, ".")
CNDefine = CNArr(0)

If NameExists(CNDefine) = True Then
'Do Nothing

Else

FName = "I:\" & File.Name
Cells(RowNdx, 1).Value = File.Name
'ActiveCell.Name = CNDefine
NameInjectRow = "=TextInject!$A$" & ActiveCell.Row
ActiveWorkbook.Names.Add Name:=CNDefine,
RefersToR1C1:=NameInjectRow

Open FName For Input Access Read As #1

While Not EOF(1)

Line Input #1, WholeLine

If Right(WholeLine, 1) <> ", " Then
WholeLine = WholeLine & ", "
End If

ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, ", ")

While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, ", ")
Wend

RowNdx = RowNdx + 1

Wend

On Error GoTo 0

Application.ScreenUpdating = True

Close #1

End If

Next

End If

oWSH.RemoveNetworkDrive "I:"

End Sub

Function NameExists(ByVal TheName As String) As Boolean
On Error Resume Next
NameExists = Len(ThisWorkbook.Names(TheName).Name) <> 0
End Function

 

[Jim Rech]

Try using RefersTo rather than RefersToR1C1.

 

[philip.widdowson]

Try using RefersTo rather than RefersToR1C1.

Hi Jim,

Thanks for such a quick response, I hadn't really expected one so
fast.

The suggestion you made fixed it, I must say thank you a lot as I have
made my job a lot easier with the above macro.

Thnx so much! who would've thought it'd be so simple!

--Phil