lucpian
02-27-2008, 02:00 PM
Hi All,
I do have this code which I have written to import external data from excel workbooks to an excel template with buttons for automation, but some reason it is not working. Here is the code.
Public Sub ImportExtdata(FName As String, Sep As String)
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
'On Error GoTo EndMacro:
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row
Open FName For Input Access Read As #1
While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' StartImport
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub StartImport()
Dim FileName As Variant
Dim Sep As String
FileName = Application.GetOpenFilename(FileFilter:="Excel File(*.xls),*.xls")
If FileName = False Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
Exit Sub
End If
Debug.Print "FileName: " & FileName, "Separator: " & Sep
ImportExtdata FName:=CStr(FileName), Sep:="|"
End Sub
My problem is that it is not working at all. It will dialog to where the excel files, but does not work. Please, can someone out there help me out.
Thanks
Lucpian
I do have this code which I have written to import external data from excel workbooks to an excel template with buttons for automation, but some reason it is not working. Here is the code.
Public Sub ImportExtdata(FName As String, Sep As String)
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
'On Error GoTo EndMacro:
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row
Open FName For Input Access Read As #1
While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' StartImport
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub StartImport()
Dim FileName As Variant
Dim Sep As String
FileName = Application.GetOpenFilename(FileFilter:="Excel File(*.xls),*.xls")
If FileName = False Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
Exit Sub
End If
Debug.Print "FileName: " & FileName, "Separator: " & Sep
ImportExtdata FName:=CStr(FileName), Sep:="|"
End Sub
My problem is that it is not working at all. It will dialog to where the excel files, but does not work. Please, can someone out there help me out.
Thanks
Lucpian