D
davith
Hello,
I got a VBA script from this group to import files with VBA and it has
worked like a charm until yesterday. Now the processor stays pegged @
100% utilization when running the script and the import takes forever..
I thought it was a samba issue since I was pulling files from a mapped
drive, but I copied them locally and get the same results.
Any ideas?
script for reference:
Public Sub re_import_files()
Dim even As Integer
Dim mod2 As Integer
even = 2
For Each Cell In Selection
' mod2 = (even - 2) * Int(even / 2)
mod2 = even Mod 2
even = even + 1
If mod2 = 0 Then
Sheets(Cell.Value).Activate
' AddSheet Cell.Value, "Template"
Else
ImportTextFile Cell.Value, Chr(9)
End If
Next
End Sub
Public Sub ImportTextFile(Fname As String, Sep As String)
Dim RowNdx As Integer
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
SaveColNdx = 1
RowNdx = 1
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
Sub AddSheet(Sname As String, Fname As String)
Sheets.Add After:=Sheets(Fname)
ActiveSheet.Name = Sname
End Sub
Sub AddSheets()
For Each Cell In Selection
'Sheets.Add After:=Sheets("Template")
'ActiveSheet.Name = Cell.Value
AddSheet Cell.Value, "Template"
Next
End Sub
I got a VBA script from this group to import files with VBA and it has
worked like a charm until yesterday. Now the processor stays pegged @
100% utilization when running the script and the import takes forever..
I thought it was a samba issue since I was pulling files from a mapped
drive, but I copied them locally and get the same results.
Any ideas?
script for reference:
Public Sub re_import_files()
Dim even As Integer
Dim mod2 As Integer
even = 2
For Each Cell In Selection
' mod2 = (even - 2) * Int(even / 2)
mod2 = even Mod 2
even = even + 1
If mod2 = 0 Then
Sheets(Cell.Value).Activate
' AddSheet Cell.Value, "Template"
Else
ImportTextFile Cell.Value, Chr(9)
End If
Next
End Sub
Public Sub ImportTextFile(Fname As String, Sep As String)
Dim RowNdx As Integer
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
SaveColNdx = 1
RowNdx = 1
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
Sub AddSheet(Sname As String, Fname As String)
Sheets.Add After:=Sheets(Fname)
ActiveSheet.Name = Sname
End Sub
Sub AddSheets()
For Each Cell In Selection
'Sheets.Add After:=Sheets("Template")
'ActiveSheet.Name = Cell.Value
AddSheet Cell.Value, "Template"
Next
End Sub