Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Access and Access VBA > Access
| Search | Today's Posts | Mark Forums Read
Access Discussion of Microsoft Access database design and programming. See also the forums for Access ASP and Access VBA.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Access section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old August 6th, 2004, 01:06 PM
Registered User
 
Join Date: Aug 2004
Location: , , .
Posts: 3
Thanks: 0
Thanked 0 Times in 0 Posts
Default Adding the records into Field F1 while importing a

:(
I designed a program that imports an excel file with 30 spreadsheets into an existing ACC2000 table(Test1) at a time. I also need to take each spreadsheet names and added into the field F1. The spreadsheet are named like 3-3-03, 3-4-03, 3-5-03, and so on. they are DATE type in F1. The field F1 is first column in each of spreadsheet of the excile file. Some of cells are blank in the first column. (The spreadsheets are multiple headings, I set up range as A7:T110, but it's not case here.)

My program works for importing all spreadsheets at a time so far, but not adding spreadsheet name in the field F1. I wrote some code within the loop of spreadsheet importing that is supposed to add the names after importing a spreadsheet in to the table Test1 and before moving to next spreadsheet.

My code is the followings, please give me some ideas:

Private Sub Import_xls_Click()
Dim strSQL As String
   Dim stDocName As String
   Dim xlWorkbook As Excel.Workbook
   Dim Intcounter As Integer
   Dim strFilename As String
   Dim eachSheetName As String
   Dim myRange As String

   Dim i As Integer
   Dim strSheetName As String

   DoCmd.SetWarnings False
   'Delete Table Import
   strSQL = "Delete tbl_Test from tbl_Test"
   DoCmd.RunSQL (strSQL)

   'import xls
   'This is for the GetOpenFileName function in comdlg32.dll(public vaiables)

   strFilename = BrowseFile("C:\", ".xls")

   Set xlWorkbook = Excel.Workbooks.Open(strFilename)
   Intcounter = xlWorkbook.Sheets.Count

   i = 1
   Do Until i = Intcounter + 1
   'Sheet Name and Range
   strSheetName = xlWorkbook.Sheets(i).Name
   eachSheetName = strSheetName + "$"
   myRange = eachSheetName + "A7:T110"
   DoCmd.TransferSpreadsheet acImport, 8, "Test1", strFilename, False, myRange

   'Modify the Field1 of Test1
            Dim db As Database
            Dim rst As Recordset
            Dim rsTable As Recordset

            Dim ValueOfF1 As String

            Set db = CurrentDb
            Set rst = CurrentDb.OpenRecordset("Text1")
            With rst

                    .Fields.Append "DueDate", adDate
                With rst!DueDate
                     rst.MoveFirst
                     While Not rst.EOF
                        rst!DueDate.Value = eachSheetName
                        rst.AddNew
                        rst.MoveNext
                    Wend
                End With
            End With
            Set rst = Noting

   i = i + 1
   Loop

   xlWorkbook.Close
   Set xlWorkbook = Nothing
End Sub






Similar Threads
Thread Thread Starter Forum Replies Last Post
importing spreadsheet with field mappings skrj02 Access VBA 9 January 11th, 2017 12:48 PM
Problem , importing thousand records from Excel azizur123 ASP.NET 2.0 Professional 2 November 12th, 2008 04:07 AM
Importing a bitmap to an ole field rohan_man Access 6 February 13th, 2005 11:57 PM
Adding the records into Field F1 while importing a jcui@bankofny.com VB Databases Basics 0 August 6th, 2004 01:43 PM
Adding the records into Field F1 while importing jcui@bankofny.com Pro VB Databases 0 August 6th, 2004 01:41 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.