Import data from csv/xls in Access, changing Date props [SOLVED]

[pookie62]

Hi guys,
I need to import from xsl or csv file into MSAccess with VBA code.
(Several users have to be able to download the updated file and import the data in their own local copy of MS Access db.)
The data in this file is coming from MySQL db and has a field "Date" i.e "2004-09-18 00:00:00". In the MSAccess table the Date field the notation is 18-09-2004.
How can I do this ?
This is the importing code to update the table:
Any help is much appreciated !!


Private Sub Importwedstrijd_Click()
On Error GoTo Err_Importwedstrijd_Click

If MsgBox("U staat op het punt om de wedstrijd Tabel te vervangen" _
& vbCrLf & "middels deze Importfunctie." & vbCrLf & "Weet U dit zeker?", _
vbYesNo, "Import van wedstrijdtabel") = vbYes Then _

Dim ImportFile As String
Dim Import As String
'DoCmd.SetWarnings False

On Error GoTo Import
DoCmd.DeleteObject acTable, "wedstrijd_copy"

Import:
'Temp tabel maken waarnaar je je gegevens importeert
DoCmd.CopyObject , "wedstrijd_copy", acTable, "wedstrijd"

'Temp tabel weer leegmaken
'DoCmd.RunSQL "DELETE * FROM wedstrijd_copy"

'Gegevens importeren in temp tabel
ImportFile = Application.CurrentProject.Path & "\wedstrijd.csv"
DoCmd.TransferText acImportDelim, , "wedstrijd_copy", ImportFile, True

'Nieuwe records opnemen
DoCmd.RunSQL "INSERT INTO wedstrijd" _
& " SELECT * FROM wedstrijd_copy" _
& " WHERE wedstrijd_copy.Id NOT IN" _
& " (SELECT wedstrijd.Id FROM wedstrijd);"

'Tabel wedstrijd bijwerken
DoCmd.RunSQL "UPDATE wedstrijd INNER JOIN wedstrijd_copy" _
& " ON wedstrijd.Id = wedstrijd_copy.Id" _
& " SET wedstrijd.Naam = wedstrijd_Copy.Naam," _
& " wedstrijd.Plaats = wedstrijd_Copy.Plaats," _
& " wedstrijd.Datum = wedstrijd_Copy.Datum" _
& " AND (Year(wedstrijd_copy.Datum)>2005);"

DoCmd.SetWarnings True

MsgBox "De originele tabel wedstrijd is gekopieerd naar wedstrijd_copy." & vbCrLf & _
"Indien er een foutmelding is verschenen controleer dan de gegevens" & vbCrLf & _
"van het geimporteerde Excelbestand met de nieuwe tabel wedstrijd.", _
vbExclamation, "Check Data"
Else
MsgBox "Import wedstrijd gestopt", , "Geen kopie gemaakt"
End If

Exit_Importwedstrijd_Click:
Exit Sub

Err_Importwedstrijd_Click:
MsgBox Err.Description
Resume Exit_Importwedstrijd_Click

End Sub

[brianbaart]

You could use:
left(string, 10)

I am sure there are other ways but I always take the easy road.

Met vriendelijke groeten,
Brian

[pookie62]

Hoi Brian,
Thanks for your reply, but as I'm not to experienced in writing code, can you explain where and how to use your solution ?

Thanks !
Hans

[brianbaart]

'Tabel wedstrijd bijwerken
DoCmd.RunSQL "UPDATE wedstrijd INNER JOIN wedstrijd_copy" _
& " ON wedstrijd.Id = wedstrijd_copy.Id" _
& " SET wedstrijd.Naam = wedstrijd_Copy.Naam," _
& " wedstrijd.Plaats = wedstrijd_Copy.Plaats," _
& " wedstrijd.Datum = wedstrijd_Copy.Datum" _
& " AND (Year(wedstrijd_copy.Datum)>2005);"

Depending where the error ocurs you could do:
strDate = LEFT(wedstrijd_Copy.Datum, 10)
And in the code above change
& " wedstrijd.Datum = wedstrijd_Copy.Datum" _
In
& " wedstrijd.Datum = strDate" _
But again I do not know where the error happens.
With kind regards,
Brian

[pookie62]

Changed the code but now I get an error saying en variable isn't defined.
Marked is wedstrijd_copy in the strDate line
This is the code now:

strDate = Left(wedstrijd_copy.Datum, 10)

'Tabel wedstrijd bijwerken
DoCmd.RunSQL "UPDATE wedstrijd INNER JOIN wedstrijd_copy" _
& " ON wedstrijd.Id = wedstrijd_copy.Id" _
& " SET wedstrijd.Naam = wedstrijd_copy.Naam," _
& " wedstrijd.Plaats = wedstrijd_copy.Plaats," _
& " wedstrijd.Datum = strDate" _
& " AND (Year(wedstrijd_copy.Datum)>2005);"

Any ideas ?

[brianbaart]

Sorry Hans,

The variable wedstrijd_Copy.Datum isn't usable outside the "sub".
Try this one:
Change everything back as was.
Then change this line:
& " wedstrijd.Datum = wedstrijd_Copy.Datum" _
In:
& " wedstrijd.Datum = " & format(wedstrijd_Copy.Datum, vbshortdate) _

[pookie62]

Hi Brian,
Sorry, but this makes no difference...:-( again I get the error that a variable is not defined, and the marked words are wedstrijd_Copy in the new line.
Thanks for your time, really appreciate !

[brianbaart]

Dear Hans,

OK let's see.....
The string you make with DoCmd.RunSQL "UPDATE .....
can not be altered.
What if you change the property from the field date in string so that the table isn't a date anymore but a text field?
That's cheating but if it works.

[pookie62]

I appreciate your efforts, but I would have to change this property in all databases which are spread all over the country...

No option I think..

[brianbaart]

Dear hans,

Could you show a line in the *.csv file?

You could alter the line, save the file and then read the file.
This is what I do for a living.
Open files read or/and change the contents and import them into other programs.

Brian

[pookie62]

Hi Brian,
Oke, here are a few lines form the wedstrijd.csv file :

Id;Naam;Datum;Plaats
-574798580;Turf Trophy;18-9-2004;Vinkeveen
-1555558832;Corso Fun Shoot 2005;17-9-2005;Tiel

I was trying initially importing from xls file, does that makes much difference ?
Anyway, the code >2005 isn't working either, all values are imported (about 35) as record but Date field is filled only with zero's..

Thing is, I use almost te same code for importing an xls file for the Contesters table. Db users through the country download directly from MySQL, save the file as *.xls in same dir as the db is and import works fine.
I do it this way, so the RI stays intact.
Maybe an idea to attach the MSdb ? I would have to strip some private data of course but that can be done. just let me know.
Thanks again very much for your help and time !!!

Hans

[brianbaart]

Dear Hans,
So you want to change:
Id;Naam;Datum;Plaats
-574798580;Turf Trophy;18-9-2004;Vinkeveen
In:
Id;Naam;Datum;Plaats
-574798580;Turf Trophy;2004-09-18 00:00:00;Vinkeveen
Right?
You know how to open a file,
read a file, change the file and save the file?

"I was trying initially importing from xls file, does that makes much difference ?"
No open a xls file with wordpad then you will see.

Don't understand the last of your post.
You are saying that other people can save and import the file but not you?
What is a RI?
Brian

[pookie62]

Hi Brian,
It's the other way around.
I extract from Mysql and save to .xls file.
The Id, Naam, Datum, Plaats field are all in the xls, but the Date field looks like this : 18-9-2004 0:00:00
When I import into my local MS db the value in the Date field contains only 0:00:00 and no date !
And I need the date but not the time..


RI stands for Referential Integrity, which needs to be there in the MS db.
I was trying to explain that the code posted earlier, is almost the way is should be, because I use the same (minor adjustments) code for letting the spreaded users download a deelnemer.xls file to update their local deelnemer table.

[brianbaart]

Dear Hans,

It is still the same isn't. Open the file change the value (lose the zero's) safe the file.
You could use vba or use vb.
I would use vba if it is a xls file (write a macro) and vb if it is a csv file.
Do al the users need to change it or only you?

If you open the xls file and change the property of the colom (cntrl + 1) and change the prop. in date you can change the yyyy-dd-mm in dd-mm-yyyy safe the file and try again. If it works you can make a macro which does it automatic.

If it is a csv file write a little program :
Open the file
make an array: split(line, ";")
take the 3 array
convert the array
put it all back together
save the file.
You can even make a line which sorts the year problem you have.

If you want me to write some code for you let me know.

Brian

[pookie62]

Hi Brian,
Oke, I'm going to try and create this macro..
If you want to, you can write me some code, is always helpfull !!
Thanks again !!

Hans

[brianbaart]

OK Hans,

Sent me a copy of the file please.

Brian

[pookie62]

Hi Brian,
I send the files which needs to be imported to your private email.
getting a rather long post.. :-))

[pookie62]

Here is a part allready which is partly working.

File = Application.CurrentProject.Path & "\wedstrijd.xls"
    Set oApp = CreateObject("Excel.Application")
    Set wbXL = oApp.Workbooks.Add
    Set wsXLValues = wbXL.Worksheets
    On Error Resume Next
    
    oApp.Visible = True
    oApp.Workbooks.Open FileName:=File
    
    wsXLValues.Range("C:C").NumberFormat = "dd/mm/yyyy"
    wsXLValues.Range("G1:G3").Interior.ColorIndex = 6 'Yellow
       
    oApp.Saved = True
    oApp.Quit

The file opens but is not formatting the column C in the desired format.
Don't know why...

[pookie62]

I'll attach a testdb and the xls file for testing purposes..

This is the code I have now.
With following issues:
All dates are 30-12-1899, xls file needs to be saved with same name ans closed (automatically).

Private Sub Importwedstrijd_Click()
On Error GoTo Err_Importwedstrijd_Click
 
If MsgBox("U staat op het punt om de wedstrijd Tabel te vervangen" _
& vbCrLf & "middels deze Importfunctie." & vbCrLf & "Weet U dit zeker?", _
vbYesNo, "Import van wedstrijdtabel") = vbYes Then _
 
change_xls
 
 
Dim ImportFile As String
Dim Import As String
'DoCmd.SetWarnings False
 
On Error GoTo Import
DoCmd.DeleteObject acTable, "wedstrijd_copy"
 
Import:
'Temp tabel maken waarnaar je je gegevens importeert
DoCmd.CopyObject , "wedstrijd_copy", acTable, "wedstrijd"
 
'Temp tabel weer leegmaken
'DoCmd.RunSQL "DELETE * FROM wedstrijd_copy"
 
'Gegevens importeren in temp tabel
ImportFile = Application.CurrentProject.Path & "\wedstrijd.xls"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel3, "wedstrijd_copy", ImportFile, True
 
'Nieuwe records opnemen
DoCmd.RunSQL "INSERT INTO wedstrijd" _
& " SELECT * FROM wedstrijd_copy" _
& " WHERE wedstrijd_copy.Id NOT IN" _
& " (SELECT wedstrijd.Id FROM wedstrijd);"
 
'Tabel wedstrijd bijwerken
DoCmd.RunSQL "UPDATE wedstrijd INNER JOIN wedstrijd_copy" _
& " ON wedstrijd.Id = wedstrijd_copy.Id" _
& " SET wedstrijd.Naam = wedstrijd_Copy.Naam," _
& " wedstrijd.Plaats = wedstrijd_Copy.Plaats," _
& " wedstrijd.Datum = wedstrijd_Copy.Datum" _
& " AND (Year(wedstrijd_copy.Datum)=2005);"
 
 
 
DoCmd.SetWarnings True
 
MsgBox "De originele tabel wedstrijd is gekopieerd naar wedstrijd_copy." & vbCrLf & _
"Indien er een foutmelding is verschenen controleer dan de gegevens" & vbCrLf & _
"van het geimporteerde Excelbestand met de nieuwe tabel wedstrijd.", _
vbExclamation, "Check Data"
Else
MsgBox "Import wedstrijd gestopt", , "Geen kopie gemaakt"
End If
 
Exit_Importwedstrijd_Click:
Exit Sub
 
Err_Importwedstrijd_Click:
MsgBox Err.Description
Resume Exit_Importwedstrijd_Click
 
End Sub
 
Private Function change_xls()
 
Dim oApp As Object
Dim File As String
Dim xlsheet
 
File = Application.CurrentProject.Path & "\wedstrijd.xls"
    Set oApp = CreateObject("Excel.Application")
    On Error Resume Next
    
    oApp.Visible = True
    oApp.Workbooks.Open Filename:=File
    
    Set xlsheet = oApp.Application.activeworkbook.sheets("wedstrijd")
    With xlsheet
    .range("C:C").NumberFormat = "dd/mm/yyyy"
    End With
    
    oApp.SaveAs Filename:=File
    oApp.Quit
 
End Function

[brianbaart]

Dear Hans,

I have made some vba code for you.

Sub Auto_Open()

Workbooks.Open Filename:="wedstrijd.xls"
Columns("C:C").Select
Selection.NumberFormat = "mm/dd/yyyy"
ActiveWorkbook.Save
ActiveWindow.Close
Application.quit

End Sub

If you make a new xls file,
Open the vba editor (alt + F11)
add a new module
place the above code in the module
and save as in the same dir as the wedstrijd.xls
when you open the file aanpassen.xls the sub auto_open is automaticly started and when finished auto closed.

(If you place an auto close "quit" in a sub which opens automaticly and also closes itself, you can't open the file long enough to press alt+ F11)

Now in you vb code (in which you can not place vba code) you can open the aanpassen.xls
Like so:

Call ShellExecute(hWnd, "Open", "aanpassen.xls", "", "C:\", 1)

You open the .xls file which changes the date prop. and saves the file and closes itself. The user must have excel on his or her computer.

Try this......and let me know.
Brian

[pookie62]

Hi Brian,
Thanks for the code, but I want to open, adjust,save and close the (downloaded) wedstrijd.xls from the MSAccess db prior to the import of the data in the wedstrijd.xls
This piece of code needs some checking (see previous post)

Private Function change_xls()
 
Dim oApp As Object
Dim File As String
Dim xlsheet
 
File = Application.CurrentProject.Path & "\wedstrijd.xls"
    Set oApp = CreateObject("Excel.Application")
    On Error Resume Next
    
    oApp.Visible = True
    oApp.Workbooks.Open Filename:=File
    
    Set xlsheet = oApp.Application.activeworkbook.sheets("wedstrijd")
    With xlsheet
    .range("C:C").NumberFormat = "dd/mm/yyyy" 
    End With
    
    oApp.SaveAs Filename:=File ' Doesn't work
    oApp.Quit 'doesn't work
 
End Function

[pookie62]

Got it ! (first part..going to make a new thread about date props in MSdb)
This is the function I made and is doing what I want..
Posting it for others to use..

Private Function change_xlsdate()
 
Dim oApp As Object
Dim File As String
Dim xlsheet
Dim xlwb
 
File = Application.CurrentProject.Path & "\wedstrijd.xls"
    Set oApp = CreateObject("Excel.Application")
    On Error Resume Next
    
    oApp.Visible = False
    oApp.Workbooks.Open Filename:=File
    
    Set xlsheet = oApp.Application.activeworkbook.sheets("wedstrijd")
    With xlsheet
    .range("C:C").NumberFormat = "dd/mm/yyyy"
    End With
    
    Set xlwb = oApp.Application.activeworkbook
    xlwb.Save = True
    xlwb.Close
        
    oApp.Quit
 
End Function