Notifikationer

Markér alle som læst Log ud

wolfgang Praktikant

15. oktober 2003 - 12:11 Der er 8 kommentarer og
1 løsning

Eksport af Access database til csv

Jeg har fundet dette fremragende script, som jeg er i gang med at modificere.

Jeg har brug at springe hele udvælgelsesfasen over og gå direkte til exporten.

Dvs. klikke af hvilke tabeller man ønsker at bruge og så fortsætte direkte til exporten.

Håber I kan hjælpe.

MVH
Wolfgang

<%

Dim DSNtemp,Conn,RS,action,arrTables,intTable,i,j,x,y,strFields,objFSO,objFile,strLine

'Insert your own DSN info here
DSNtemp="Provider=MSDASQL;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.Mappath("data/CoreData.mdb") & ";"

Set Conn = Server.CreateObject("ADODB.Connection")
Conn.open DSNtemp,"admin",""

action = Request("action")

If action = "" Then
Set RS = Conn.OpenSchema(20) '--> adSchemaTables = 20
RS.Filter = "TABLE_TYPE = 'TABLE'"

Response.Write "<form action=""" & Request.ServerVariables("SCRIPT_NAME") & "?action=getfields"" method=""POST"">" & VbCrLf
Response.Write "Select table(s):<BR>" & VbCrLf
Do While Not RS.EOF
Response.Write "<input type=""checkbox"" name=""tables"" value=""" & RS(2) & """>" & RS(2) & "<BR>" & VbCrLf
RS.MoveNext
Loop
Response.Write "<BR><input type=""submit"" value=""Next >>"">"
RS.Close
Set RS = Nothing
End If

If action = "getfields" Then
arrTables = Split(Replace(Request("tables")," ",""), ",")

Response.Write "<form action=""" & Request.ServerVariables("SCRIPT_NAME") & "?action=getrecords"" method=""POST"">" & VbCrLf
Response.Write "<input type=""hidden"" name=""tables"" value=""" & Join(arrTables, ",") & """>" & VbCrLf
Response.Write "<input type=""hidden"" name=""next"" value=""0"">" & VbCrLf
Response.Write "Select field(s):<BR>" & VbCrLf
For i = LBound(arrTables) to UBound(arrTables)
Response.Write "Table: " & arrTables(i) & "<BR>" & VbCrLf
Set RS = Conn.Execute("SELECT * FROM " & arrTables(i))
For j = 0 to RS.Fields.Count-1
Response.Write "<input type=""checkbox"" name=""" & arrTables(i) & """ value=""" & RS.Fields(j).Name & """>" & RS.Fields(j).Name & "<BR>" & VbCrLf
Next
RS.Close
Response.Write "<input type=""checkbox"" name=""" & arrTables(i) & """ value=""*"">All Fields<BR>" & VbCrLf
Response.Write "<BR>"
Next
Response.Write "<input type=""submit"" value=""Next >>"">"
Set RS = Nothing
End If

If action = "getrecords" And Not Request("next") = "end" Then
arrTables = Split(Request("tables"), ",")
intTable = Request("next")
If Instr(Request(arrTables(intTable)),"*") = 0 Then strFields = Request(arrTables(intTable)) Else strFields = "*"

Response.Write "<form action=""" & Request.ServerVariables("SCRIPT_NAME") & "?action=getrecords"" method=""POST"">" & VbCrLf
Response.Write "<input type=""hidden"" name=""tables"" value=""" & Request("tables") & """>" & VbCrLf
Response.Write "<input type=""hidden"" name=""table"" value=""" & arrTables(intTable) & """>" & VbCrLf

For i = LBound(arrTables) to UBound(arrTables)
Response.Write "<input type=""hidden"" name=""" & arrTables(i) & """ value=""" & Request(arrTables(i)) & """>" & VbCrLf
Next

If intTable >= 1 Then
For i = 0 to intTable-1
Response.Write "<input type=""hidden"" name=""" & arrTables(i) & "_rec"" value=""" & Replace(Request(arrTables(i) & "_rec")," ", "") & """>" & VbCrLf
Next
End If

If intTable+1 <= UBound(arrTables) Then
Response.Write "<input type=""hidden"" name=""next"" value=""" & intTable+1 & """>" & VbCrLf
Else
Response.Write "<input type=""hidden"" name=""next"" value=""end"">" & VbCrLf
End If

Response.Write "Table: " & arrTables(intTable) & "<BR>" & VbCrLf
Response.Write "Fields: " & strFields & "<BR><BR>" & VbCrLf
Response.Write "Select record(s):<BR>" & VbCrLf

j = 0

Set RS = Conn.Execute("SELECT " & Request(arrTables(intTable)) & " FROM " & arrTables(intTable))
Do While Not RS.EOF
If Instr(Request(arrTables(intTable)), ",") > 0 or Request(arrTables(intTable)) = "*" Then
Response.Write "<input type=""checkbox"" name=""" & arrTables(intTable) & "_rec"" value=""" & j & """>" & Left(RS(0),10) & "," & Left(RS(1),10) & "<BR>" & VbCrLf
Else
Response.Write "<input type=""checkbox"" name=""" & arrTables(intTable) & "_rec"" value=""" & j & """>" & Left(RS(0),10) & "<BR>" & VbCrLf
End If
RS.MoveNext
j = j + 1
Loop
Response.Write "<input type=""checkbox"" name=""" & arrTables(intTable) & "_rec"" value=""ALL"">All records<BR>" & VbCrLf
Response.Write "<BR><input type=""submit"" value=""Next >>"">"
RS.Close
Set RS = Nothing
End If

If action = "getrecords" and Request("next") = "end" Then

guid = server.createobject("scriptlet.typelib").guid
guid=Left(guid,instr(guid,"}"))
guid=replace(guid,"{","")
guid=replace(guid,"}","")
guid=replace(guid,"-","")
NewGuid=guid
set guid=nothing

Dim arrRecs,strOutput
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.CreateFolder("C:\Inetpub\wwwroot\Kontaktbase\BackupFiles\" & NewGuid & "")
arrTables = Split(Request("tables"), ",")
strOutput = Server.MapPath(".") & "\BackupFiles\" & NewGuid & "\" '<-- Edit this to change your output directory

For i = LBound(arrTables) to UBound(arrTables)
Set objFile = objFSO.CreateTextFile(strOutput & Trim(arrTables(i)) & ".CSV")
Set RS = Conn.Execute("SELECT " & Request(arrTables(i)) & " FROM " & arrTables(i))
strLine = ""

If Instr(Request(arrTables(i)),"*") = 0 Then
objFile.WriteLine Replace(Request(arrTables(i)), " ", "")
Else
For j = 0 to RS.Fields.Count-1
strLine = strLine & RS.Fields(j).Name
If j < RS.Fields.Count-1 Then strLine = strLine & ","
Next
objFile.WriteLine strLine
End If

If Instr(Request(arrTables(i) & "_rec"), "ALL") <> 0 Then
Do While Not RS.EOF
strLine = ""
For j = 0 to RS.Fields.Count-1
If Not IsNull(RS(j)) Then strLine = strLine & Chr(34) & Replace(RS(j), Chr(34), Chr(34) & Chr(34)) & Chr(34)
If j < RS.Fields.Count-1 Then strLine = strLine & ","
Next
objFile.WriteLine strLine
RS.MoveNext
Loop
Else
arrRecs = Split(Replace(Request(arrTables(i) & "_rec")," ",""),",")
x = 0
y = 0

Do While Not RS.EOF
strLine = ""
If Not x > UBound(arrRecs) Then
If y = Int(arrRecs(x)) Then
For j = 0 to RS.Fields.Count-1
If Not IsNull(RS(j)) Then strLine = strLine & Chr(34) & Replace(RS(j), Chr(34), Chr(34) & Chr(34)) & Chr(34)
If j < RS.Fields.Count-1 Then strLine = strLine & ","
Next
objFile.WriteLine strLine
x = x + 1
End If
End If
y = y + 1
RS.MoveNext
Loop
End If

objFile.Close
Set objFile = Nothing
Next
Response.Write "Done.<BR>" & VbCrLf
For i = LBound(arrTables) to UBound(arrTables)
Response.Write "Created: " & Server.MapPath(".") & "\BackupFiles\" & NewGuid & "\" & Trim(arrTables(i)) & ".CSV" & "<BR>" & VbCrLf
Next
End If
%>

Synes godt om

hnteknik Novice

15. oktober 2003 - 13:16 #1

PuHA

Jeg skrev engang dette skript - måske kan du bruge det:

<%
call table2CSV(mySQL,conn, myfile, delim)

sub table2CSV(outputquery, outputDSN, filename,delim )
dim conntemp, rstemp, linetxt
set conntemp=server.createobject("adodb.connection")
' 0 sekunder betyder vent forever, default er 15
conntemp.connectiontimeout=0
conntemp.open outputDSN
set rstemp=conntemp.execute(outputquery)
howmanyfields=rstemp.fields.count -1
Set fs = CreateObject("Scripting.FileSystemObject")
'Set file = fs.OpenTextFile(server.mappath(filename), 8, True, False)
Set file = fs.CreateTextFile(server.mappath(filename))
linetxt=""
if isnull(delim) then
delim=";"
end if
for i=0 to howmanyfields-1
linetxt = linetxt & rstemp(i).name & delim
next
linetxt = linetxt & rstemp(i).name
file.Writeline(linetxt)

DO UNTIL rstemp.eof
linetxt=""

for i = 0 to howmanyfields-1
thisvalue=rstemp(i)
If isnull(thisvalue) then
thisvalue=" "
end if
linetxt = linetxt & thisvalue & delim
next
thisvalue=rstemp(i)

If isnull(thisvalue) then
thisvalue=" "
end if

linetxt = linetxt & thisvalue

'lad os fjerne de linefeeds
linetxt=Replace(linetxt, vbcrlf, " ")

file.Writeline(linetxt)
rstemp.movenext

loop
file.close
set file=nothing
Set fs=nothing
rstemp.close
set rstemp=nothing
conntemp.close
set conntemp=nothing
end sub
sub delCSV(filename)
Set fs = CreateObject("Scripting.FileSystemObject")

if fs.FileExists(server.mappath(filename)) then
Set file = fs.GetFile(server.mappath(filename))
file.Delete
if not fs.FileExists(server.mappath(filename)) then
response.write filename & " er nu slettet <br>"
else
response.write filename & " blev ikke slettet <br>"
end if
else
response.write filename & " er ikke tilstede <br>"
end if
set file=nothing
Set fs=nothing
end sub
%>

Synes godt om

soes Nybegynder

15. oktober 2003 - 17:26 #2

>> wolfgang
Af ren og skær nysgerighed. Hvor fandt du scriptet som du postede?

Synes godt om

wolfgang Praktikant

16. oktober 2003 - 09:42 #3

Hej Soes,

Jeg fandt det på www.asp101.com.

Jeg var selv gået igang med at lave noget lignende, men da jeg fandt dette stoppede jeg rimelig hurtigt :D

Det er faktisk ret frækt lavet.

MVH
Wolfgang

Synes godt om

wolfgang Praktikant

16. oktober 2003 - 09:47 #4

>> hnteknik
Du bliver nok lige nød til at forklare din kode lidt bedre.

Jeg er ikke helt med på dit forslag.

Uddrag fra ?
Jeg har brug at springe hele udvælgelsesfasen (Se Script) over og gå direkte til exporten.

Dvs. klikke af hvilke tabeller man ønsker at bruge og så fortsætte direkte til exporten.

Håber I kan hjælpe.

MVH
Wolfgang

Synes godt om

hnteknik Novice

16. oktober 2003 - 10:58 #5

>> Udvælgelsesdelen kan du tge fra dit fiffige script.

og så calde mit script fra en løkke, der løber det igennem.

call table2CSV(mySQL,conn, myfile, delim)

mysql er en "select * fra nytable"
conn er databaseforbindelsen, som du bruger
myfile er filen, som du ønsker at gemme i
delim kan angives, hvis det ikke skal være ;

sub delCSV(filename)
Husk at slette csv filen fra din server, når du har downloaded dine data.
CSV filen kan nemt findes af en filsøge server.

Synes godt om

wolfgang Praktikant

16. oktober 2003 - 11:21 #6

Hej hnteknik,

Jeg er sgu ked af det, men jeg er bare ikke hardcore nok til at forstå din forklaring.

Hvis du vil være så behjælpelig at flette de 2 scripts sammen som du foreslår, vil jeg være meget taknemlig.

Beklager ulejligheden.

MVH
Wolfgang

Synes godt om

hnteknik Novice

16. oktober 2003 - 20:34 #7

Jeg holder efterårsferie, så der er dømt lav PC profil, men

jeg har kigget lidt på din kode, som jeg vist nok har ret i, at du har rettet lidt i, for det virker ikke helt efter hensigten.

1. Du skal rette stien til til din egen database. Umiddelbart virker det kun til Access, da jeg bliver afvist af min MYSQL databasse.

2. den løber 3 forløb igennem 1. vælg tabeller, 2 vælg atributter og 3 vælg records.

på den sidte hænger den - umiddelbart ser det ud til at være denne script del:

Dim arrRecs,strOutput
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.CreateFolder("C:\Inetpub\wwwroot\Kontaktbase\BackupFiles\" & NewGuid & "")
arrTables = Split(Request("tables"), ",")
strOutput = Server.MapPath(".") & "\BackupFiles\" & NewGuid & "\" '<-- Edit this to change your output directory

man skal have tilladelse til at oprette mapper på serveren:
"C:\Inetpub\wwwroot\Kontaktbase\BackupFiles\"

kunne sikkert med fordel udskiftes med
Server.MapPath(".") & "\BackupFiles\"

man kan jo springe de to sidste led over ved at kalde sidste led direkte og efter linien:
For i = LBound(arrTables) to UBound(arrTables)

call table2CSV(mySQL,conn, myfile, delim)

hvor

mysql = ("SELECT " & Request(arrTables(i)) & " FROM " & arrTables(i))

Synes godt om

hnteknik Novice

16. oktober 2003 - 20:42 #8

UPS

mysql = "SELECT * FROM " & arrTables(i)
conn = din aktuelle forbindelsesstreng ala ="Provider=MSDASQL;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.Mappath("data/CoreData.mdb") & ";"

Jeg ville bruge en mere up-to-date conn streng - HAR DEN IKKE LIGE HER MEN KIG F.EKS. UNDER ACCESS HOS AZERO.DK.
myfile = Trim(arrTables(i)) & ".CSV"
delim =";"

Jeg ville springe det backup mappe fis over.
Mit script skriver CSV filen direkte i mappen
Et overordnet script laver en link til filen på den side, der dannes.

Delete scriptet skal blot laves om, så det sletter alle CSV filer i mappen efter endt download.

Så meget fra vesterhavshytten.

Synes godt om

wolfgang Praktikant

16. oktober 2003 - 20:53 #9

Hej HNTeknik,

Tusind tak for din hjælp.
Det var lige hvad der skulle til.

Og god efterårsferie :D

MVH
Wolfgang

Synes godt om

Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Følg dette spørgsmål

Opret Preview

Programmeringssprog kurser

Kurser inden for grundlæggende programmering

Se alle Programmeringssprog kurser

Flere spørgsmål fra ASP kategorien

Titel	Indlæg	Oprettet	Seneste aktivitet
Jeg bakser med noget Database og If Then med ASP - hvad gør jeg galt? Af Peer i ASP	10	25/06/202622:20	I dag 02:30
Tjek alle checkbox i form Af bsn i ASP	4	18/05/202601:57	19/05/202613:33
Lost focus Af bsn i ASP	1	07/11/202415:34	01/01/202514:58
ASP classic Af bsn i ASP	8	28/10/202423:11	30/10/202422:51
Classic - filer vist med sidste fil først Af bsn i ASP	5	23/05/202409:56	24/05/202400:02

Se alle spørgsmål i kategorien Opret spørgsmål

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten

Seneste artiklerRSS