First four columns lose formatting when DAO macro is run

  • Thread starter Alex Barrow-Williams
  • Start date
A

Alex Barrow-Williams

Dear All

This is my first post in the group so I hope someone will be able to help -
and also apologies if there is something obvious I have missed! I have set
up a workbook with a module to pull data from an access database on a server
using DAO 3.6 object library. The module runs when the workbook opens and
inserts data into various different worksheets. However, when I run the
macro a second time (to effectively refresh the data from the database) the
format of columns A through D changes to short date from accounting,
percentage etc. There is no mention of changing formats in the module at
all (it is literally just there to pull the data in). This also means that
when I try to use April, May, June etc as the values for the x-axis of a
chart that it is coming up with numbers. I have searched KB, google and the
help files and have found nothing. I am running Windows XP pro and Office
XP Developer Edition SP2.

I hope someone will be able to help - even if it is just to tell me to
uninstall office and start over!

Thanks in advance for any guidance you can give me

Alex

Alex Barrow-Williams

****Start Code****

Sub FetchData()

Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Dim strPath As String


strPath = "G:\PCDB\Data.mdb"

strSQL = "SELECT tblProjects.ProjectID, tblProjects.Named, tblProjects.Date,
" & _
"tblCompanies.Company, tblProjects.Leader, tblProjects.Team,
tblProjects.Description, " & _
"IIf([SumOfTotalCost] Is Null,[Price],([Price]+[SumOfTotalCost])) AS
Expr1, " & _
"IIf([SumOfTotalCost] Is
Null,[GrossProfit],([Expr1]-([Price]-[GrossProfit]+[SumOfDirectCost]))) " &
_
"AS Expr2 " & _
"FROM tblCompanies LEFT JOIN " & _
"(tblSites LEFT JOIN (tblProjects LEFT JOIN qryAdjustments ON " & _
"tblProjects.ProjectID = qryAdjustments.ID) ON tblSites.SiteID =
tblProjects.ID) " & _
"ON tblCompanies.ID = tblSites.CompanyID " & _
"WHERE (((tblProjects.ProjectID) Is Not Null And " & _
"(tblProjects.ProjectID) >= 1712)) " & _
"ORDER BY tblProjects.ProjectID;"

Set db = Workspaces(0).OpenDatabase(strPath)
Set rs = db.OpenRecordset(strSQL)
Sheets("Project Data").Range("A2").CopyFromRecordset rs

Set db = Nothing
Set rs = Nothing

***SNIP***

****Code Ends****

This code basically just repeats with different values for strSQL and
different worksheet names
 
Top