Importazione file excel in DB Access [ASP]

[fraude]

Ciao a tutti.

Ho messo a punto una procedura che tramite ASP, importa i dati di un file excel direttamente all'interno del db access ed esegue l'upload dello stesso file excel sul server.

La procedura funziona correttamente, ma ha questi "difetti":

- per importare 13 righe di un file excel ci impiega 1 minuto e 10 secondi (un pò troppo );

- non funziona la barra che indica la percentuale progressiva dell'upload del file.

Vorrei una mano ad ottimizzarlo, in maniera tale da successivamente renderlo disponibile per la community o ai forummisti interessati.

Ecco il codice, grazie:

<%
Function GetConnection()
  dim Conn: Set Conn = CreateObject("ADODB.Connection")
  Conn.Provider = "Microsoft.Jet.OLEDB.4.0"
  Conn.open "Data Source=" & Server.MapPath("mdb-database/upload.mdb") 
  set GetConnection = Conn
end function

Function SplitFileName(FullPath)
  Dim Pos, PosF
  PosF = 0
  For Pos = Len(FullPath) To 1 Step -1
    Select Case Mid(FullPath, Pos, 1)
      Case ":", "/", "\": PosF = Pos + 1: Pos = 0
    End Select
  Next
  If PosF = 0 Then PosF = 1
 SplitFileName = PosF
End Function

Function GetPath(FullPath)
  GetPath = left(FullPath, SplitFileName(FullPath)-1)
End Function

Function GetUniqueFileName(FileName, DestPath)
  if isempty(gFS) then Set gFS = CreateObject("Scripting.FileSystemObject")
  Dim Counter, FullPath, NewFileName
  Counter = 1
  NewFileName = FileName
  
  if gFS.FileExists(DestPath & "\" & NewFileName) then
		Do 
			Counter = Counter + 1
			NewFileName = Counter & "_" & FileName
		Loop while gFS.FileExists(DestPath & "\" & NewFileName)
  end if
  GetUniqueFileName = NewFileName
End Function


Dim DestinationPath
DestinationPath = Server.mapPath(VirtualFolder) & "\"

Dim Form: Set Form = New ASPForm %><% 

Server.ScriptTimeout = 2000
Form.SizeLimit = &HA00000

if len(Request.QueryString("UploadID"))>0 then
	Form.UploadID = Request.QueryString("UploadID")'{/b}
end if


If Form.State = 0 Then

  Const VirtualFolder = "UploadFolder"

  Dim File, DestFileName
  For Each File In Form.Files.Items
		If Len(File.FileName) > 0 Then
        DestFileName = GetUniqueFileName(File.FileName, DestinationPath)

        File.SaveAs DestinationPath & "\" & DestFileName


	  End If

  Dim virtDestinationPath
  virtDestinationPath = "http://" + Request.ServerVariables("SERVER_NAME") _
   + GetPath(Request.ServerVariables("SCRIPT_NAME") ) _
   + "/" + VirtualFolder + "/"
  

  Dim FileField
  For Each FileField in Form.Files.Items
   
    if len(FileField.FileName)> 0 then 
          Dim DestinationFileName

      DestinationFileName = DestinationPath & FileField.FileName

      FileField.SaveAs DestinationFileName
            
      Dim Conn, RS, oRs, intCount, contRighe, bolErrorCAT, ErrorField
     
      DestinationFileName = "UploadFolder/" & Form("File1").FileName
      Set Conn = GetConnection
       
      Set RS = Server.CreateObject("ADODB.Recordset")
      Rs.Open "SELECT * from [DATI$]", "DRIVER=Microsoft Excel Driver (*.xls); DBQ=" & Server.MapPath(DestinationFileName)
      
      Set oRs = Server.CreateObject("ADODB.Recordset")
      oRS.Open "ListFiles", GetConnection, 2, 2
       
   intCount = 0  
   contRighe = 1
   
Do Until Rs.Eof 

If Rs("CAT") <> "" and Rs("ID_CAT") <> "" and ... Then

bolErrorCAT = true
if bolErrorCAT = true then
oRS.AddNew

    
    oRs("CAT") = Rs("CAT")  
    oRs("ID_CAT") = Rs("ID_CAT")                       
    ...
    
if IsNull(Rs("CAT")) or IsEmpty(Rs("CAT")) or Len(Rs("CAT"))="" then 
 oRs("CAT")= NULL
 else
 oRs("CAT")= Rs("CAT")
end if
                       
   
    
    oRS("ContentType") = Form("File1").ContentType
    oRS("UploadDT") = Now()
    oRS("Description") = Form("Desc-" & FileField.Name)
    oRS("SourceFileName") = virtDestinationPath & DestFileName
    oRS("DestFileName") = DestinationFileName
    oRS("DataSize") = FileField.Length
    oRS("Description") = Form("Description")
    oRS("Title") = Form("Title")
    oRS("Email") = Form("Email")
          
    oRs.Update
    
  intCount = intCount + 1
  contRighe = contRighe + 1 
    
else

bolErrorCAT = false
break

end if 
end if

Rs.MoveNext

Loop 

if bolErrorCAT = false then  
response.write "Errore!"
end if 

Rs.close    
  set Rs=nothing    
  oRs.Close
  Set oRs = Nothing   
  Conn.Close
  Set Conn = Nothing    

end if

Next 
   
Next
  
ElseIf Form.State > 10 then
  Const fsSizeLimit = &HD
  Select case Form.State
		case fsSizeLimit: response.write  "
<Font Color=red>Source form size (" & Form.TotalBytes & "B) exceeds form limit (" & Form.SizeLimit & "B)</Font>
"
		case else response.write "
<Font Color=red>Some form error.</Font>
"
  end Select
End If'Form.State = 0 then

Dim UploadID, PostURL
UploadID = Form.NewUploadID

PostURL = Request.ServerVariables("SCRIPT_NAME") & "?UploadID=" & UploadID
%>

<SCRIPT>
function ProgressBar(){
  var ProgressURL
  ProgressURL = 'progress.asp?UploadID=<%=UploadID%>'

  var v = window.open(ProgressURL,'_blank','toolbar=no,location=no,directories=no,status=no,menubar=no,scrollbars=no,resizable=yes,width=350,height=200')
  
  return true;
}
</SCRIPT>