Reading xlsx using fso -logic..
in [Forms]
|
From: mls via AccessMonster.com on 4 May 2010 15:25 I am reading an excel spreadsheet that has data starting from line 3 and store it in Access 2007 database. It has coulmn names but they are not relavant so I want to skip them and assign a different name. There are around 250 columns so I am just trying to read a few columns to test my code. I don't wan to use transferdb as there are format issues. Ex: Age has 6 mo. as well numeric data so 6mo coming out missing. My temp_str shows all junk character any idea? Private Sub readxl() Dim fso As New FileSystemObject Dim Tst As TextStream Dim strline As String Dim strFilePath As String Dim i As Integer Dim Strfilename As String ' Access objects: Dim objDB As DAO.Database Dim mylog As DAO.Recordset ' Scripting Objects: Dim objFSO As Scripting.FileSystemObject DoCmd.RunSQL "Delete * from Demography;" strFilePath = "temp\Study_test.xlsx" i = 1 'Set ReportDb = CurrentDb Set objDB = CurrentDb() Set mydemo = objDB.OpenRecordset("Demography") ' Add a new record If fso.FileExists(strFilePath) Then Set Tst = fso.OpenTextFile(strFilePath, ForReading, False) Do Until Tst.AtEndOfStream strline = Tst.ReadLine If (i > 3) Then Dim Identifier As String Dim Date_Recieved As Date Dim Date_Collected As Date Dim type As String Dim Age As String Dim Gender As String temp_str = Mid(strline, InStr(strline, ":") + 1) MyArray = Split(temp_str, ",") mydemo.AddNew mydemoIdentifier] = MyArray(0) mydemo![Date_Recieved] = MyArray(1) mydemo![Date_Collected] = MyArray(2) mydemo![type] = MyArray(3) mydemo.Update End If i = i + 1 Loop Tst.Close End If mydemo.Close End Sub -- Message posted via AccessMonster.com http://www.accessmonster.com/Uwe/Forums.aspx/access-formscoding/201005/1
From: Mark Andrews on 4 May 2010 17:49 You could use Excel automation instead of FSO, here's an example I had which reads an excel file that has a header and a section with a bunch of rows (hope it is close enough that you can understand the example): HTH -- Mark Andrews RPT Software http://www.rptsoftware.com http://www.donationmanagementsoftware.com -------------------------------------------- Private Function ImportASingleWorksiteHazardSurvey(strfilename As String) As Boolean On Error GoTo Err_ImportASingleWorksiteHazardSurvey 'Use excel automation to open the excel file and retrieve values from cells 'end result is one new record in tblImportWorksiteHazardSurvey and multiple records ' in tblImportWorksiteHazardSurveyLine Dim objActiveWkb As Object Dim objXL As Object Dim Sheet As Object Dim booXLCreated As Boolean Dim rs As DAO.Recordset Dim strSQL As String Dim i As Integer Dim LocationID As Long Dim WorksiteHazardSurveyID As Long Dim LastJobTitleOrTask As String Dim LastRiskHazard As String Dim result As Boolean DoCmd.Hourglass True result = False ' Get a instance of Excel that we can use ' If it's already open, use it. ' Otherwise, create an instance of Excel. ' I'm doing this by trying to use the Excel object. ' If it doesn't exist, an error will be raised, and ' that tells me to create an Excel instance. On Error Resume Next Set objXL = GetObject(, "Excel.Application") ' An error will be raised if Excel isn't already open. If Err.Number = 0 Then booXLCreated = False Else Set objXL = CreateObject("Excel.Application") booXLCreated = True End If On Error GoTo Err_ImportASingleWorksiteHazardSurvey 'open an existing workbook (hopefully it is an excel "WORKSITE HAZARD-RISK / SAFETY SURVEY" form with a certain format, otherwise you will get errors) Set objActiveWkb = objXL.Workbooks.Open(strfilename) Set Sheet = objActiveWkb.Worksheets(1) 'Check first cell for heading to make sure it is the correct type of form If Sheet.Cells(8, 1).Value <> "WORKSITE HAZARD-RISK / SAFETY SURVEY" Then MsgBox ("Unable to import this file - it is not a 'WORKSITE HAZARD-RISK / SAFETY SURVEY'.") GoTo End_ImportASingleWorksiteHazardSurvey End If 'Check for valid SiteNumber and save LocationID LocationID = Nz(DLookup("LocationID", "tblLocation", "SiteCode = """ & Sheet.Cells(2, 31).Value & """"), 0) If (LocationID = 0) Then MsgBox ("Unable to find a Location, based on SiteCode '" & Sheet.Cells(2, 31).Value & "' in the database.") GoTo End_ImportASingleWorksiteHazardSurvey End If 'Check if location already has a record for this date If DLookup("WorksiteHazardSurveyID", "tblWorksiteHazardSurvey", "LocationID=" & LocationID & " AND AssessedByDate=#" & Sheet.Cells(33, 31).Value & "#") Then If MsgBox("Location " & Sheet.Cells(4, 29).Value & " already has data for " & Sheet.Cells(33, 31).Value & "." & vbCrLf _ & "Are you sure you want to import this form.", vbQuestion + vbYesNo, "Worksite Hazard-Risk / Safety Survey Import") = vbNo Then GoTo End_ImportASingleWorksiteHazardSurvey End If 'retrieve values from excel file and populate variables 'Now we append a new record to tblWorksiteHazardSurvey Set rs = CurrentDb.OpenRecordset("tblWorksiteHazardSurvey", dbOpenDynaset) rs.AddNew 'Note all Cell values are (ROW, COL) rs("LocationID") = LocationID 'determine above rs("Building") = Sheet.Cells(6, 29).Value rs("AssessedBy") = Sheet.Cells(33, 1).Value rs("AssessedBySignature") = Sheet.Cells(33, 16).Value rs("AssessedByDate") = Sheet.Cells(33, 31).Value rs.Update 'Get the last WorksiteHazardSurveyID that was added rs.Bookmark = rs.LastModified WorksiteHazardSurveyID = Nz(rs!WorksiteHazardSurveyID, 0) rs.Close If (WorksiteHazardSurveyID = 0) Then 'should never happen MsgBox ("Unable to import this file - problem adding the header, contact RPT Software for help.") GoTo End_ImportASingleWorksiteHazardSurvey End If 'special check for first row (must have both fields, otherwise we don't append ANY rows) If ((Nz(Sheet.Cells(12, 1).Value, "") = "") And (Nz(Sheet.Cells(12, 5).Value, "") = "")) Then MsgBox ("Unable to import this file - there is NO detail lines specified or the FIRST line has blanks in 'Job Title/Tas' and 'Risk Hazard'.") CurrentDb.Execute "DELETE * FROM tblWorksiteHazardSurvey where WorksiteHazardSurveyID = " & WorksiteHazardSurveyID GoTo End_ImportASingleWorksiteHazardSurvey End If 'Now we append multiple records to tblWorksiteHazardSurveyLine Set rs = CurrentDb.OpenRecordset("tblWorksiteHazardSurveyLine", dbOpenDynaset) For i = 12 To 28 'data on rows 12 thru 28 'if value in 'job title/task' or 'Risk Hazard' then add row If ((Nz(Sheet.Cells(i, 1).Value, "") <> "") Or (Nz(Sheet.Cells(i, 5).Value, "") <> "")) Then rs.AddNew rs("WorksiteHarzardSurveyID") = WorksiteHazardSurveyID 'determine above If (Nz(Sheet.Cells(i, 1).Value, "") = "") Then rs("JobTitleOrTask") = LastJobTitleOrTask Else rs("JobTitleOrTask") = Sheet.Cells(i, 1).Value LastJobTitleOrTask = Sheet.Cells(i, 1).Value End If If (Nz(Sheet.Cells(i, 5).Value, "") = "") Then rs("RiskHazard") = LastJobTitleOrTask Else rs("RiskHazard") = Sheet.Cells(i, 5).Value LastRiskHazard = Sheet.Cells(i, 5).Value End If rs("Head") = Sheet.Cells(i, 21).Value rs("Foot") = Sheet.Cells(i, 23).Value rs("Eye") = Sheet.Cells(i, 25).Value rs("Hand") = Sheet.Cells(i, 27).Value rs("Ear") = Sheet.Cells(i, 29).Value rs("Resp") = Sheet.Cells(i, 31).Value rs("Cover") = Sheet.Cells(i, 33).Value rs("Other") = Sheet.Cells(i, 35).Value rs.Update End If Next i rs.Close 'Close the workbook objActiveWkb.Close result = True End_ImportASingleWorksiteHazardSurvey: On Error Resume Next ' Clean up after yourself! Set objActiveWkb = Nothing If booXLCreated Then objXL.Application.Quit End If Set objXL = Nothing Set rs = Nothing DoCmd.Hourglass False ImportASingleWorksiteHazardSurvey = result Exit Function Err_ImportASingleWorksiteHazardSurvey: MsgBox Err.Number & ": " & Err.Description & " in ImportASingleWorksiteHazardSurvey", _ vbOKOnly + vbCritical, "Error" Resume End_ImportASingleWorksiteHazardSurvey End Function -------------------------------------------- "mls via AccessMonster.com" <u55943(a)uwe> wrote in message news:a7839c3154fa2(a)uwe... > I am reading an excel spreadsheet that has data starting from line 3 and > store it in Access 2007 database. It has coulmn names but they are not > relavant so I want to skip them and assign a different name. There are > around > 250 columns so I am just trying to read a few columns to test my code. > > I don't wan to use transferdb as there are format issues. Ex: Age has 6 > mo. > as well numeric data so 6mo coming out missing. > > My temp_str shows all junk character any idea? > > Private Sub readxl() > > Dim fso As New FileSystemObject > Dim Tst As TextStream > Dim strline As String > Dim strFilePath As String > Dim i As Integer > Dim Strfilename As String > > ' Access objects: > > Dim objDB As DAO.Database > Dim mylog As DAO.Recordset > ' Scripting Objects: > Dim objFSO As Scripting.FileSystemObject > > > DoCmd.RunSQL "Delete * from Demography;" > > strFilePath = "temp\Study_test.xlsx" > i = 1 > 'Set ReportDb = CurrentDb > > > Set objDB = CurrentDb() > Set mydemo = objDB.OpenRecordset("Demography") > > ' Add a new record > > If fso.FileExists(strFilePath) Then > > Set Tst = fso.OpenTextFile(strFilePath, ForReading, False) > Do Until Tst.AtEndOfStream > > strline = Tst.ReadLine > If (i > 3) Then > Dim Identifier As String > Dim Date_Recieved As Date > Dim Date_Collected As Date > Dim type As String > Dim Age As String > Dim Gender As String > > temp_str = Mid(strline, InStr(strline, ":") + 1) > MyArray = Split(temp_str, ",") > mydemo.AddNew > mydemoIdentifier] = MyArray(0) > mydemo![Date_Recieved] = MyArray(1) > mydemo![Date_Collected] = MyArray(2) > mydemo![type] = MyArray(3) > mydemo.Update > End If > > i = i + 1 > Loop > > Tst.Close > End If > mydemo.Close > > End Sub > > -- > Message posted via AccessMonster.com > http://www.accessmonster.com/Uwe/Forums.aspx/access-formscoding/201005/1 >
From: mls via AccessMonster.com on 5 May 2010 08:49 Hi Mark, can you post the example please? Thanks Mark Andrews wrote: >You could use Excel automation instead of FSO, here's an example I had which >reads an excel file that has a header and a section with a bunch of rows >(hope it is close enough that you can understand the example): > >HTH > >> I am reading an excel spreadsheet that has data starting from line 3 and >> store it in Access 2007 database. It has coulmn names but they are not >[quoted text clipped - 67 lines] >> >> End Sub -- Message posted via AccessMonster.com http://www.accessmonster.com/Uwe/Forums.aspx/access-formscoding/201005/1
From: Mark Andrews on 5 May 2010 20:44 I put the code in the last reply. I can't give you the database I took this example from. Email me if you need a text file with the code or something like that. Mark Andrews RPT Software http://www.rptsoftware.com http://www.donationmanagementsoftware.com "mls via AccessMonster.com" <u55943(a)uwe> wrote in message news:a78cb948dc0d0(a)uwe... > Hi Mark, can you post the example please? > > Thanks > Mark Andrews wrote: >>You could use Excel automation instead of FSO, here's an example I had >>which >>reads an excel file that has a header and a section with a bunch of rows >>(hope it is close enough that you can understand the example): >> >>HTH >> >>> I am reading an excel spreadsheet that has data starting from line 3 and >>> store it in Access 2007 database. It has coulmn names but they are not >>[quoted text clipped - 67 lines] >>> >>> End Sub > > -- > Message posted via AccessMonster.com > http://www.accessmonster.com/Uwe/Forums.aspx/access-formscoding/201005/1 >
From: mls via AccessMonster.com on 6 May 2010 08:59
I just need text file not database. Sorry I could not find the code in last reply. Mark Andrews wrote: >I put the code in the last reply. I can't give you the database I took this >example from. Email me if you need a text file with the code or something >like that. > >Mark Andrews >RPT Software >http://www.rptsoftware.com >http://www.donationmanagementsoftware.com > >> Hi Mark, can you post the example please? >> >[quoted text clipped - 11 lines] >>>> >>>> End Sub -- Message posted via http://www.accessmonster.com |