[求助]关于上传本地文件到Access的VBA Code问题

sVen8848

目前的工作流程是这样

3种不同的生产数据上传到公司的SERVER--->我将其分类下载至本地C盘--->写了一个VBA的CODE完成将下载的数据文本(

2个.txt类型的一个EXCEL类型)，code如下

---

Private Sub Prüfimport_Click()



' erstellt  : 24.08.2005 FB

' letzte Ä  :

' Ziel      :Importieren von Daten aus einer Excel-Datei in die Tabelle tabgrdprüf

' Parameter :

' Rückgabe  : -

' Bemerkung : -

' Aufrufe   :

' Err-Check : ja

' Zunächst werden die alten Tabelleninhalte gelöscht

CurrentDb().Execute "Delete from tabtempprüf_Import"

CurrentDb().Execute "Delete from tabgrdprüf" '

On Error GoTo Prüfimport_ERR

gstrFehlerDetail = ""

gintFehlerNummer = 0

'|----

' Datei enthält die jeweilige Datei beim Durchlaufen des Ordners

' Blatt verweist auf das entsprechende Tabellenblatt innnerhalb der gerade aktuellen Datei, die ausgelesen wird.

' nbytes und LCount werden in dem Modul Vbex deklariert

Dim Datei As String

Dim Blatt As String

Dim db As Database

Set db = CurrentDb

Dim rs As DAO.Recordset

Dim nBytes As Currency

Dim lCount As Long

Dim varelement As Variant

' zunächst Anzahl Dateien ermitteln

lCount = VBEX_FileCount("C:\Prüfdaten", 1, "*.xls", nBytes)

'Fehlermeldung wenn keine Daten im Zieverzeichnis

If lCount = -1 Then

   MsgBox "Das gewählte Verzechnis enthält keine Prüf-Dateien." & vbNewLine & _

               "Bitte Kopieren sie die entsprechenden Dateien in das Verzeichnis", vbCritical + vbOKOnly, "Fehler..."

   Exit Sub

Else

   ' Array dimensionieren

   ReDim sFiles(lCount) As String

   lCount = VBEX_FileList("c:\Prüfdaten", 1, "*.xls", sFiles(), nBytes)

End If

'Schleife über alle Dateien

For Each varelement In sFiles()

    Datei = "C:\Prüfdaten\" & varelement

    Blatt = "Messprotokoll"

  Dim xlMappe As Object

  Set xlMappe = GetObject(Datei)

  ReDim x(9, 9)

  For RowIndex = 4 To 8

    For ColIndex = 2 To 9

      x(RowIndex, ColIndex) = _

         xlMappe.Worksheets(Blatt).Cells(RowIndex, ColIndex).Value

    Next ColIndex

  Next RowIndex

  xlMappe.Close SaveChanges:=False

  Set xlMappe = Nothing

  

'Tabelle öffnen

Set rs = db.OpenRecordset("tabtempprüf_Import", dbOpenTable)

'Daten aus Array in Tabelle schreiben

rs.AddNew

rs("Kundeteilnr") = x(4, 2)

rs("Seriennr") = x(5, 2)

rs("Datum") = x(7, 2)

rs("Uhrzeit") = x(8, 2)

rs("Hubrate") = x(6, 9)

rs("Rollrate") = x(7, 9)

rs.Update

Next

'|----

Prüfimport_EXIT:

    Set db = Nothing

    MsgBox "Die Prüfstandsdaten wurden erfolgreich importiert"

    DoCmd.SetWarnings False

    DoCmd.OpenQuery "Qry_tabtempprüf_Import_Sortierung->tabgrdprüf", acViewNormal

    Exit Sub

Prüfimport_ERR:

   

    Select Case Err

        Case 3022

        Resume Next

    End Select

   

    gstrProzedurName = "rüfimport"

    gstrProzedurType = "ublic Function"

    gstrFehlerSource = "In der " & gstrProzedurType & " " & gstrProzedurName & " in " _

        & cmstrObjektType & " " & cmstrObjektName & " ist es zu einem Fehler gekommen."

    If gstrFehlerDetail = "" Then gstrFehlerDetail = Err.Description

    If gintFehlerNummer = 0 Then gintFehlerNummer = Err.Number

    gstrErrmsg = gintFehlerNummer & ": " & gstrFehlerSource & " " & gstrFehlerDetail

    MsgBox (gstrFehlerSource & Chr(13) & gstrFehlerDetail), vbOKOnly, "Fehlermeldung"

    'If Err.Number = 0 Then GoTo Prüfimport_EXIT

    Call gError.log(gstrErrmsg, gstrErrMemo, gstrProzedurName, True, cmstrObjektName, _

        Application.CurrentObjectType, Nz(Application.CurrentObjectName, "<>Unbekannt"))

    Resume Prüfimport_EXIT

   

End Sub

---

实在不好意思，由於我用的是德文的系统，可能在表格命名上都是德文写法！

我大概说明下！

Prüfimport ： 我要上传的文件德文就是 “Prüfdaten” 其信息是在每个单个的EXCEL文件中！

CurrentDb().Execute "Delete from tabtempprüf_Import"

CurrentDb().Execute "

sVen8848

请大家帮忙看看 谢谢！

cg1

关于此主题请参考：

    《表》数据库与图片或者文件的关系如何处理？

    http://access911.net/index.asp?u1=a&u2=71FAB51E16DC

sunwrsun

看看