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