Excel error when importing into Access 2003

[h20vrrq]

I have an Access 2003 database that scans a folder for excel workbooks, opens them and imports various ranges from within the workbook. The owner of the workbooks has changed a coupl of the worksheets and now when then import runs I get the message 'This workbook contains links to other data sources'.

Is it possible to suppress/ignore this message?

 

[PHV]

imports various ranges from within the workbook
How ?
Anyway, have a look here:

http://support.microsoft.com/kb/826921

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[SkipVought]

hi,

Use this Excel Application Method

Application.DisplayAlerts = False

before you Open any workbook.


Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[h20vrrq]

Hi,

Does the excel application method work in Access? Where would it go?

Private Sub Command0_Click()
EmptyTables
Dim pPathname As String
pPathname = "\\cat\kieranm\BudgetTesting\2012\"
FilesInFolder (pPathname)
End Sub
Sub EmptyTables()
Dim db As Database
Set db = CurrentDb



DoCmd.SetWarnings False
db.Execute "DELETE * FROM [Summary_Totals]"
db.Execute "DELETE * FROm [Summary_Totals_CapExp]"
db.Execute "DELETE * FROM [Summary_2011_Forecast]"
db.Execute "DELETE * FROM [Summary_2012_Budget]"
db.Execute "DELETE * FROM [Summary_2012_Budget_FTEs]"
db.Execute "DELETE * FROM [Summary_Cap_Exp_2011_Forecast]"
db.Execute "DELETE * FROM [Summary_Cap_Exp_Carry_over_Proj_2012_Budget]"
db.Execute "DELETE * FROM [Income]"
db.Execute "DELETE * FROM [Salary]"
db.Execute "DELETE * FROM [Salary_Summary]"
db.Execute "DELETE * FROM [Salary_FTEs]"
db.Execute "DELETE * FROM [OpCost]"
db.Execute "DELETE * FROM [OvCost]"
db.Execute "DELETE * FROM [PNA_Activity_Description]"
db.Execute "DELETE * FROM [PNA_IE_Summary]"
db.Execute "DELETE * FROM [PNA_IE_Summary_FTEs]"
db.Execute "DELETE * FROM [PNA_Income]"
db.Execute "DELETE * FROM [PNA_Salary]"
db.Execute "DELETE * FROM [PNA_Salary_Summary]"
db.Execute "DELETE * FROM [PNA_Inc_Salary_Summary]"
db.Execute "DELETE * FROM [PNA_Salary_Summary_FTEs]"
db.Execute "DELETE * FROM [PNA_OpCost]"
db.Execute "DELETE * FROM [PNA_OvCost]"
db.Execute "DELETE * FROM [PNA_Cap_Exp]"
DoCmd.SetWarnings True


' Delete tables beginning _Import
For I = 0 To db.TableDefs.Count - 1
If Left(db.TableDefs(I).Name, 7) = "_Import" Then
   db.Execute "DROP TABLE " & db.TableDefs(I).Name
End If
Next

Set db = Nothing

End Sub

Sub FilesInFolder(SourceFolderName As String)
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim pTablename(1 To 10000) As String
Dim pFilename(1 To 10000)  As String
Dim pRange(1 To 10000)  As String
Dim pIndex As Integer
Dim j As Integer

Dim aTablename(1 To 10000) As String
Dim aFilename(1 To 10000) As String
Dim aRange(1 To 10000) As String

Dim sheetcount As Integer
sheetcount = 0
[Forms]![Budgets]![TransferCount].Value = Str(0)
Dim Summcount As Integer
Summcount = 0
Dim Inccount As Integer
Inccount = 0
Dim Salcount As Integer
Salcount = 0
Dim Opccount As Integer
Opccount = 0
Dim Ovccount As Integer
Ovccount = 0
Dim PNAcount As Integer
PNAcount = 0

        [Forms]![Budgets]![Summary].Value = Str(Summcount)
        [Forms]![Budgets]![Income].Value = Str(Inccount)
        [Forms]![Budgets]![Salary].Value = Str(Salcount)
        [Forms]![Budgets]![OpCost].Value = Str(Opccount)
        [Forms]![Budgets]![OvCost].Value = Str(Ovccount)
        [Forms]![Budgets]![PNA].Value = Str(PNAcount)
        [Forms]![Budgets]![Total].Value = Str(sheetcount)
        Me.Repaint



Dim LogFileName As String
LogFileName = SourceFolderName & "log.txt"
Dim FileNum As Integer
FileNum = FreeFile ' next file number
Open LogFileName For Output As #FileNum
Set xlapp = CreateObject("Excel.Application")

    
    'Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    [Forms]![Budgets]![Activity].Value = "Collecting Sheets"
    
    For Each FileItem In SourceFolder.Files
        If Right(FileItem.Name, 3) = "xls" Then
        Print #FileNum, "XLS File:" & FileItem.Name
        
        Set xlBook = xlapp.Workbooks.Open(FileItem.Path)
        For Each tWS In xlBook.Worksheets
        
        Dim k As Integer
        For k = 1 To 10000
           pTablename(k) = ""
           pFilename(k) = ""
           pRange(k) = ""
        Next k
        
        pIndex = 0

' --------------------------------------------------------------------

        If tWS.Name = "Summary" Then
            pIndex = pIndex + 1
            pTablename(pIndex) = "Summary_Totals"
            pFilename(pIndex) = SourceFolderName & FileItem.Name
            pRange(pIndex) = tWS.Name & "!C10:Y14"
            Summcount = Summcount + 1
        End If
 
' --------------------------------------------------------------------

        If tWS.Name = "Summary" Then
            pIndex = pIndex + 1
            pTablename(pIndex) = "Summary_Totals_CapExp"
            pFilename(pIndex) = SourceFolderName & FileItem.Name
            pRange(pIndex) = tWS.Name & "!C16:Y16"
        End If
       
 ' --------------------------------------------------------------------
  

        If tWS.Name = "Summary" Then
            pIndex = pIndex + 1
            pTablename(pIndex) = "Summary_2011_Forecast"
            pFilename(pIndex) = SourceFolderName & FileItem.Name
            pRange(pIndex) = tWS.Name & "!A21:Y25"
        End If
       
 ' --------------------------------------------------------------------
  
        If tWS.Name = "Summary" Then
            pIndex = pIndex + 1
            pTablename(pIndex) = "Summary_2012_Budget"
            pFilename(pIndex) = SourceFolderName & FileItem.Name
            pRange(pIndex) = tWS.Name & "!A29:Y33"
        End If
       
' ---------------------------------------------------------------------
 
        If tWS.Name = "Summary" Then
            pIndex = pIndex + 1
            pTablename(pIndex) = "Summary_2012_Budget_FTEs"
            pFilename(pIndex) = SourceFolderName & FileItem.Name
            pRange(pIndex) = tWS.Name & "!A35:Y35"
        End If
       
 ' --------------------------------------------------------------------
  
        If tWS.Name = "Summary" Then
            pIndex = pIndex + 1
            pTablename(pIndex) = "Summary_Cap_Exp_2011_Forecast"
            pFilename(pIndex) = SourceFolderName & FileItem.Name
            pRange(pIndex) = tWS.Name & "!A39:Y39"
        End If
        
 ' --------------------------------------------------------------------
 
        If tWS.Name = "Summary" Then
           pIndex = pIndex + 1
             pTablename(pIndex)  "Summary_Cap_Exp_Carry_over_Proj_2012_Budget"
            pFilename(pIndex) = SourceFolderName & FileItem.Name
            pRange(pIndex) = tWS.Name & "!A43:Y43"
        End If
        
 ' --------------------------------------------------------------------
 
         For j = 1 To pIndex
            If pTablename(j) <> "" Then
                Print #FileNum, "Worksheet:" & tWS.Name
                sheetcount = sheetcount + 1
                aTablename(sheetcount) = pTablename(j)
                aFilename(sheetcount) = pFilename(j)
                aRange(sheetcount) = pRange(j)
      
                   
        [Forms]![Budgets]![CurrentFile].Value = pFilename(j)
        [Forms]![Budgets]![CurrentSheet].Value = tWS.Name
        [Forms]![Budgets]![Summary].Value = Str(Summcount)
        [Forms]![Budgets]![Income].Value = Str(Inccount)
        [Forms]![Budgets]![Salary].Value = Str(Salcount)
        [Forms]![Budgets]![OpCost].Value = Str(Opccount)
        [Forms]![Budgets]![OvCost].Value = Str(Ovccount)
        [Forms]![Budgets]![PNA].Value = Str(PNAcount)
        [Forms]![Budgets]![Total].Value = Str(sheetcount)
        Me.Repaint
        End If
        Next j
        
        Next tWS
        
        xlBook.Close False
        End If
    Next FileItem
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    Close #FileNum
    xlapp.Quit

    ' Now transferspreadsheet for all the entries in the array
    If sheetcount > 0 Then
            [Forms]![Budgets]![Activity].Value = "Transferring Sheets to Database"
            [Forms]![Budgets]![ProgressBar9].Max = sheetcount
            Screen.MousePointer = 11
            End If
            

    For I = 1 To sheetcount
            [Forms]![Budgets]![CurrentFile].Value = aFilename(I)
            [Forms]![Budgets]![CurrentSheet].Value = aRange(I)
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, aTablename(I), aFilename(I), No, aRange(I)
            [Forms]![Budgets]![ProgressBar9].Value = I
            [Forms]![Budgets]![TransferCount].Value = Str(I)
            Me.Repaint

    Next
    
    Screen.MousePointer = 0
    [Forms]![Budgets]![Activity].Value = "Transfer Completed"

End Sub

 

[combo]

If you do not update links, use:

Set xlBook = xlapp.Workbooks.Open(FileName:=FileItem.Path,UpdateLinks:=0)

combo

 

[PHV]

Another way:
Set xlapp = CreateObject("Excel.Application")
[!]xlapp.DisplayAlerts = False[/!]

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[combo]

Excel 2003 does not block the 'update links' message and use the default 'update' after Application.DisplayAlerst=False.

combo