K
Kate
I've just switched from using DDE to OLE, in VBA from Acess
(2003), to import data from Excel. The latter seems much
simpler, and I'm familiar with Excel VBA. Please don't tell
me to use
VBA.net or some other method: I want to use OLE.
The problem is, this worked a couple of days ago, but now
doesn't. I'm opening all spreadsheets
within a certain directory, one at a time, and processing
each to:
1. correct an error in a formula within a range on a hidden
sheet, then correct a misspelling on another hidden sheet range.
2. Import named ranges into identical tables in the Access
database.
3. Save the spreadsheet under a new name in a new
directory, then delete it from the first directory.
#1 is no longer working, but #s 2 and 3 are.
I cannot figure out why the replace method is no longer
working on these spreadsheets. Does anyone have any ideas?
Thanks in advance -Kate.
Here's the relevant code:
Dim fso As New Scripting.FileSystemObject
Dim fil As Scripting.File
Dim fldr As Scripting.Folder
Dim i As Integer
Dim rst As Recordset
Dim appXL As Excel.Application
(note, I was using Dim appXL As New Excel.Application, but
after reading as much as I could find on-line about
automation errors, I thought I'd try this)
On Error GoTo Err_FSO
Set fso = CreateObject("Scripting.FileSystemObject")
'Set path to import spreadsheets
Set fldr = fso.GetFolder("S:\GlobalKraft\" & Year(Now()) &
"\Import\")
Set appXL = CreateObject("Excel.Application")
(NOTE: the above was added after I stopped using the 'New'
keyword in the dim statement)
For Each fil In fldr.Files
appXL.Workbooks.Open (fil)
With appXL.ActiveWorkbook
'correct the formula in 'data' sheet for
production area
.Unprotect
.Sheets("data").Visible = True
.Sheets("data").Activate
.ActiveSheet.Range("$D$12:$D$31").Select
.ActiveSheet.Selection.Replace
"Production!C", "Production!F", xlPart, xlByColumns, False
'correct mis-spelling on lookups sheet
.Sheets("lookups").Visible = True
.Sheets("lookups").Activate
.ActiveSheet.Range("$Y$5:$Y$7").Select
.ActiveSheet.Selection.Replace "Tonness",
"Tonnes", xlPart, xlByColumns, True
.Save
End With
.......importing and appending all the data from Excel.......
SaveName = fldr & "\Done\" & sid & ".xls"
'save the file in a subdirectory
appXL.ActiveWorkbook.SaveAs SaveName
appXL.ActiveWorkbook.Close
'check to see if file was saved successfully.
If so, delete original.
If fso.FileExists(SaveName) Then fso.DeleteFile
fil, True
Next fil
Set appXL = Nothing
(2003), to import data from Excel. The latter seems much
simpler, and I'm familiar with Excel VBA. Please don't tell
me to use
VBA.net or some other method: I want to use OLE.
The problem is, this worked a couple of days ago, but now
doesn't. I'm opening all spreadsheets
within a certain directory, one at a time, and processing
each to:
1. correct an error in a formula within a range on a hidden
sheet, then correct a misspelling on another hidden sheet range.
2. Import named ranges into identical tables in the Access
database.
3. Save the spreadsheet under a new name in a new
directory, then delete it from the first directory.
#1 is no longer working, but #s 2 and 3 are.
I cannot figure out why the replace method is no longer
working on these spreadsheets. Does anyone have any ideas?
Thanks in advance -Kate.
Here's the relevant code:
Dim fso As New Scripting.FileSystemObject
Dim fil As Scripting.File
Dim fldr As Scripting.Folder
Dim i As Integer
Dim rst As Recordset
Dim appXL As Excel.Application
(note, I was using Dim appXL As New Excel.Application, but
after reading as much as I could find on-line about
automation errors, I thought I'd try this)
On Error GoTo Err_FSO
Set fso = CreateObject("Scripting.FileSystemObject")
'Set path to import spreadsheets
Set fldr = fso.GetFolder("S:\GlobalKraft\" & Year(Now()) &
"\Import\")
Set appXL = CreateObject("Excel.Application")
(NOTE: the above was added after I stopped using the 'New'
keyword in the dim statement)
For Each fil In fldr.Files
appXL.Workbooks.Open (fil)
With appXL.ActiveWorkbook
'correct the formula in 'data' sheet for
production area
.Unprotect
.Sheets("data").Visible = True
.Sheets("data").Activate
.ActiveSheet.Range("$D$12:$D$31").Select
.ActiveSheet.Selection.Replace
"Production!C", "Production!F", xlPart, xlByColumns, False
'correct mis-spelling on lookups sheet
.Sheets("lookups").Visible = True
.Sheets("lookups").Activate
.ActiveSheet.Range("$Y$5:$Y$7").Select
.ActiveSheet.Selection.Replace "Tonness",
"Tonnes", xlPart, xlByColumns, True
.Save
End With
.......importing and appending all the data from Excel.......
SaveName = fldr & "\Done\" & sid & ".xls"
'save the file in a subdirectory
appXL.ActiveWorkbook.SaveAs SaveName
appXL.ActiveWorkbook.Close
'check to see if file was saved successfully.
If so, delete original.
If fso.FileExists(SaveName) Then fso.DeleteFile
fil, True
Next fil
Set appXL = Nothing