Creare campo database da EXCEL

Hai un problema con Excel?

Nuova discussione

Creare campo database da EXCEL
di Traniwebdesign data: 11/05/2014 07:21:15
ciao a tutti e grazie per l'aiuto che date sempre...
ho una sorta di gestionale fatto con vba, però ho perso il foglio del database fatto con access 2002.......e non so ricrearlo...
praticamnte il file excel scriveva dei valori nel database e io poi gestivo le vendite utilizzando st ofile excel.
c' nessuno che sa ricrearmi il database in modo che il file excel riconosca i campi delle tabelle e tutto torni a funzionaare ????
vi post oil codice dove sicuramente ci sono le chiamate; io ho provato ma nisba....mah.....
forse voi che siete + esperti ci riuscirete...
Grazie mille

Dim DB As Database, FonteDB As String, CellaAtt As Range, QuerySQL As String


Function IsFileOpen(FileName As String)
    Dim iFilenum As Long
    Dim iErr As Long
     
    On Error Resume Next
    iFilenum = FreeFile()
    Open FileName For Input Lock Read As #iFilenum
    Close iFilenum
    iErr = Err
    On Error GoTo 0
     
    Select Case iErr
    Case 0:    IsFileOpen = False
    Case 70:   IsFileOpen = True
    Case Else: Error iErr
    End Select
     
End Function
 
Function OpenData()
1 FonteDB = "E:GESTIONEDatabase.mdb"
On Error GoTo 1
Set DB = OpenDatabase(FonteDB)
End Function

Function CloseData()
DB.Close
End Function

'Private Sub CommandButton1_Click()
'c_ddt = Worksheets("Analisi").Cells(PosCellaSelezionata, 2).Value

'Call OpenData

'Dim RecSet As Recordset
'Set RecSet = DB.OpenRecordset("Select * from Ordini inner join DDT on Ordini.account=DDT.account and Ordini.rif=DDT.rif where DDT.DDT='" & c_ddt & "'")
   
'If RecSet.RecordCount > 0 Then
'    Call RiportaDati(RecSet)
'    Call CompilaDDT
'    Sheets("Compilazione").Select
'    ActiveSheet.Cells(42, 3).Select
'    MsgBox "Dati Importati Correttamente", vbInformation
'End If

'Call CloseData
'End Sub

Function Puliscicampi()
Worksheets("DDT").Cells(7, 8) = ""
Worksheets("DDT").Cells(11, 8) = ""
Worksheets("DDT").Cells(8, 8) = ""
Worksheets("DDT").Cells(31, 1) = ""
Worksheets("DDT").Cells(3, 5) = ""
Worksheets("DDT").Cells(7, 5) = ""
Worksheets("DDT").Cells(8, 5) = ""

Worksheets("DDT").Cells(11, 5) = ""
Worksheets("DDT").Cells(10, 5) = ""
For a = 22 To 28
Worksheets("DDT").Cells(a, 3) = ""
Worksheets("DDT").Cells(a, 4) = ""
Worksheets("DDT").Cells(a, 8) = ""
Worksheets("DDT").Cells(a, 1) = ""
Next

Worksheets("DDT").Cells(31, 1) = ""
Worksheets("DDT").Cells(32, 4) = ""
Worksheets("DDT").Cells(31, 6) = ""
Worksheets("DDT").Cells(34, 6) = ""
Worksheets("DDT").Cells(34, 7) = ""
Worksheets("DDT").Cells(34, 1) = ""

End Function

Function CompilaDDT()

Call Puliscicampi

Worksheets("DDT").Cells(7, 8) = Worksheets("Compilazione").Cells(42, 3) 'numero
Worksheets("DDT").Cells(11, 8) = Worksheets("Compilazione").Cells(43, 3) 'data
Worksheets("DDT").Cells(8, 8) = Worksheets("Compilazione").Cells(44, 3) 'riferimento
Worksheets("DDT").Cells(31, 1) = Worksheets("Compilazione").Cells(45, 3) 'spedizione

If InStr(Worksheets("DDT").Cells(31, 1), "CONTR") > 0 Then
    Worksheets("DDT").Cells(3, 5) = "CONTRASSEGNO  € " & Format(Worksheets("Compilazione").Cells(25, 3), "Standard")
End If

Worksheets("DDT").Cells(7, 5) = Worksheets("Compilazione").Cells(32, 3) 'cliente
Worksheets("DDT").Cells(8, 5) = Worksheets("Compilazione").Cells(33, 3) 'indirizzo
Worksheets("DDT").Cells(10, 5) = Worksheets("Compilazione").Cells(13, 3) 'tel
'cap città provincia
Worksheets("DDT").Cells(11, 5) = Worksheets("Compilazione").Cells(35, 3) & " - " & Worksheets("Compilazione").Cells(35, 3) & " (" & Worksheets("Compilazione").Cells(34, 3) & ")"

For a = 22 To 28
Worksheets("DDT").Cells(a, 3) = Worksheets("Compilazione").Cells(a - 5, 1)
Worksheets("DDT").Cells(a, 4) = Worksheets("Compilazione").Cells(a - 5, 3)
Worksheets("DDT").Cells(a, 8) = Worksheets("Compilazione").Cells(a - 5, 4)
If Worksheets("DDT").Cells(a, 4) <> "" Then Worksheets("DDT").Cells(a, 1) = a - 21
Next

Worksheets("DDT").Cells(31, 1) = Worksheets("Compilazione").Cells(45, 3)
Worksheets("DDT").Cells(32, 4) = Worksheets("Compilazione").Cells(46, 3)
Worksheets("DDT").Cells(31, 6) = Worksheets("Compilazione").Cells(47, 3)
Worksheets("DDT").Cells(34, 6) = Worksheets("Compilazione").Cells(48, 3)
Worksheets("DDT").Cells(34, 7) = Worksheets("Compilazione").Cells(49, 3)
Worksheets("DDT").Cells(34, 1) = Worksheets("Compilazione").Cells(50, 3)

End Function

Function RiportaDati(RecordFound As Recordset)

While RecordFound.EOF = False

s_account = RecordFound("Ordini.Account")
s_ddt = RecordFound("DDT.DDT")
s_rif = RecordFound("Ordini.Rif")
s_data = RecordFound("DDT.Data")

s_nick = RecordFound("NickName")
s_email = RecordFound("Email")
s_cognome = RecordFound("Cognome")
s_nome = RecordFound("Nome")
s_indirizzo = RecordFound("Ordini.Indirizzo")
s_citta = RecordFound("Ordini.Citta")
s_prov = RecordFound("Ordini.Prov")
s_cap = RecordFound("Ordini.Cap")
s_tel = RecordFound("Ordini.Tel")

s_cliente = RecordFound("Cliente")
s_azindirizzo = RecordFound("DDT.Indirizzo")
s_azcitta = RecordFound("DDT.Citta")
s_azprov = RecordFound("DDT.Prov")
s_azcap = RecordFound("DDT.Cap")
s_aztel = RecordFound("DDT.Tel")


s_prezzo = RecordFound("DDT.Prezzo")
s_pagamento = RecordFound("DDT.Pagamento")
s_note = RecordFound("DDT.Annotazioni")
s_spedizione = RecordFound("DDT.Spedizione")
s_datisped = RecordFound("DatiSped")

s_scontrino = RecordFound("Scontrino")
s_datascont = RecordFound("DataScontrino")
s_colli = RecordFound("Colli")
s_peso = RecordFound("Peso")

RecordFound.MoveNext

Wend


    Worksheets("Compilazione").Cells(44, 3) = s_account
    Worksheets("Compilazione").Cells(2, 3) = s_account
    Worksheets("Compilazione").Cells(42, 3) = s_ddt
    Worksheets("Compilazione").Cells(43, 3) = s_data
    
    
    Worksheets("Compilazione").Cells(5, 3) = s_nick
    Worksheets("Compilazione").Cells(6, 3) = s_email
    Worksheets("Compilazione").Cells(7, 3) = s_cognome
    Worksheets("Compilazione").Cells(8, 3) = s_nome
    Worksheets("Compilazione").Cells(9, 3) = s_indirizzo
    Worksheets("Compilazione").Cells(10, 3) = s_citta
    Worksheets("Compilazione").Cells(11, 3) = s_prov
    Worksheets("Compilazione").Cells(12, 3) = s_cap
    Worksheets("Compilazione").Cells(13, 3) = s_tel
    Worksheets("Compilazione").Cells(32, 3) = s_cliente
    Worksheets("Compilazione").Cells(33, 3) = s_azindirizzo
    Worksheets("Compilazione").Cells(34, 3) = s_azcitta
    Worksheets("Compilazione").Cells(35, 3) = s_azprov
    Worksheets("Compilazione").Cells(36, 3) = s_azcap
    Worksheets("Compilazione").Cells(37, 3) = s_aztel
    
    Worksheets("Compilazione").Cells(25, 3) = s_prezzo
    Worksheets("Compilazione").Cells(26, 3) = s_pagamento
    
    Worksheets("Compilazione").Cells(28, 3) = s_spedizione
    Worksheets("Compilazione").Cells(45, 3) = s_spedizione
    Worksheets("Compilazione").Cells(46, 3) = s_datisped
    Worksheets("Compilazione").Cells(50, 3) = s_note
    
    Worksheets("Compilazione").Cells(48, 3) = s_scontrino
    Worksheets("Compilazione").Cells(49, 3) = s_datascont
    Worksheets("Compilazione").Cells(47, 3) = s_colli
    Worksheets("Compilazione").Cells(51, 3) = s_peso
    
    Dim RecArt As Recordset
    Set RecArt = DB.OpenRecordset("Select * from Articoli where Account='" & s_account & "' and Rif='" & s_rif & "'")
    
    a = 16
    
    While RecArt.EOF = False
    
    a = a + 1
        Worksheets("Compilazione").Cells(a, 1) = RecArt("Marca")
        Worksheets("Compilazione").Cells(a, 3) = RecArt("Articoli")
        Worksheets("Compilazione").Cells(a, 4) = RecArt("Qta")
    
        
    RecArt.MoveNext
    Wend
    
End Function


Function PosCellaSelezionata()
x = ActiveCell.Row
PosCellaSelezionata = x
End Function

Private Sub CommandButton1_Click()
Dim SetRec As Recordset
Call OpenData

For i = 11 To 2000
If Worksheets("Analisi").Cells(i, 2) <> "" Then
    s_ddt = Worksheets("Analisi").Cells(i, 2)
    s_notaextra = Replace(Replace(Worksheets("Analisi").Cells(i, 8), "'", " "), "/", "-")

    DB.Execute ("UPDATE DDT Set NotaExtra='" & s_notaextra & "' where DDT='" & s_ddt & "'")
Else
    Exit For
End If
Next

Call CloseData
MsgBox "Salvataggio Note Extra Eseguito", vbInformation
End Sub

Private Sub CommandButton2_Click()
Range("A11:J2000").Select
Selection.Interior.ColorIndex = 0
Selection.ClearContents
Range("B11").Select
    

DataDal = UCase(Worksheets("Analisi").Cells(6, 3))
DataDal = Format(DataDal, "yyyy/mm/dd")
DataAl = UCase(Worksheets("Analisi").Cells(6, 4))
DataAl = Format(DataAl, "yyyy/mm/dd")

Dim RecSet As Recordset
Call OpenData
s_Sql = "SELECT * FROM DDT inner join ORDINI on DDT.DDT=ORDINI.DDT where Ordini.DDT<>''"
If DataDal <> "" Then s_Sql = s_Sql & " and Spedito>=#" & DataDal & "#"
If DataAl <> "" Then s_Sql = s_Sql & " and Spedito<=#" & DataAl & "#"
s_Sql = s_Sql & " ORDER by Spedito"
Set RecSet = DB.OpenRecordset(s_Sql)
Call ScriviRicerca(RecSet)
Call CloseData
End Sub

Function ScriviRicerca(RecordFound As Recordset)
somma = 0
contatore = 0
TotCelere3 = 0
Totcontrassegno = 0
TotAnnullati = 0
i = 10

While Not RecordFound.EOF

i = i + 1

c_ddt = i - 10
c_rif = RecordFound.Fields("Ordini.DDT")
c_account = RecordFound.Fields("DDT.ACCOUNT")
c_cliente = RecordFound.Fields("Cliente")
c_data = RecordFound.Fields("Spedito")
c_spedizione = RecordFound.Fields("DDT.Spedizione")
c_prezzo = RecordFound.Fields("DDT.prezzo")
c_notaextra = RecordFound.Fields("Stato")

Worksheets("Analisi").Cells(i, 2) = c_ddt
Worksheets("Analisi").Cells(i, 3) = c_data
Worksheets("Analisi").Cells(i, 5) = c_cliente
Worksheets("Analisi").Cells(i, 6) = c_spedizione
Worksheets("Analisi").Cells(i, 7) = c_prezzo
Worksheets("Analisi").Cells(i, 8) = c_notaextra
Worksheets("Analisi").Cells(i, 10) = c_rif

If InStr(LCase(c_notaextra), "ann") > 0 Then
    TotAnnullati = TotAnnullati + 1
Else
    If c_spedizione = "CELERE 3" Then TotCelere3 = TotCelere3 + 1
    If c_spedizione = "CELERE 3 CONTRASSEGNO" Then Totcontrassegno = Totcontrassegno + 1
    somma = somma + c_prezzo
End If

contatore = contatore + 1

'questa istruzione, una volta trasferito il record sul foglio di lavoro, fa scorrere con 'movenext (muovi al successivo) i record (se preferite: le righe) nel RecSet. Ricordo che 'RecSet ora dovete vederlo come una tabella formata da righe (record) e dai campi '(colonne) ottenuti con la query.
RecordFound.MoveNext

Wend

Worksheets("Analisi").Cells(i + 2, 6) = "TOTALE INCASSI"
Worksheets("Analisi").Cells(i + 2, 7) = somma

Worksheets("Analisi").Cells(i + 2, 6).Select
Selection.Font.Bold = True
Selection.Interior.ColorIndex = 36
Worksheets("Analisi").Cells(i + 2, 7).Select
Selection.Interior.ColorIndex = 36
Selection.Font.Bold = True

Worksheets("Analisi").Cells(i + 2, 3) = "TOTALE Spedizioni"
Worksheets("Analisi").Cells(i + 2, 3).Select
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True

Worksheets("Analisi").Cells(i + 2, 5) = contatore
Worksheets("Analisi").Cells(i + 2, 5).Select
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True



If TotCelere3 > 0 Or Totcontrassegno > 0 Then

Worksheets("Analisi").Cells(i + 4, 3) = "TOTALE CELERE 3"
Worksheets("Analisi").Cells(i + 4, 5) = TotCelere3
Worksheets("Analisi").Cells(i + 6, 3) = "TOTALE CONTR."
Worksheets("Analisi").Cells(i + 6, 5) = Totcontrassegno
Worksheets("Analisi").Cells(i + 8, 3) = "TOTALE ANNULLATI."
Worksheets("Analisi").Cells(i + 8, 5) = TotAnnullati

Worksheets("Analisi").Cells(i + 4, 6) = "SPESE CELERE 3"
Worksheets("Analisi").Cells(i + 4, 7) = TotCelere3 * 6.37
Worksheets("Analisi").Cells(i + 6, 6) = "SPESE CONTR."
Worksheets("Analisi").Cells(i + 6, 7) = Totcontrassegno * 9.37

Worksheets("Analisi").Cells(i + 4, 3).Select
Selection.Interior.ColorIndex = 34
Selection.Font.Bold = True
Worksheets("Analisi").Cells(i + 4, 5).Select
Selection.Interior.ColorIndex = 34
Selection.Font.Bold = True
Worksheets("Analisi").Cells(i + 6, 3).Select
Selection.Interior.ColorIndex = 35
Selection.Font.Bold = True
Worksheets("Analisi").Cells(i + 6, 5).Select
Selection.Interior.ColorIndex = 35
Selection.Font.Bold = True
Worksheets("Analisi").Cells(i + 8, 3).Select
Selection.Interior.ColorIndex = 40
Selection.Font.Bold = True
Worksheets("Analisi").Cells(i + 8, 5).Select
Selection.Interior.ColorIndex = 40
Selection.Font.Bold = True
Worksheets("Analisi").Cells(i + 4, 6).Select
Selection.Interior.ColorIndex = 34
Selection.Font.Bold = True
Worksheets("Analisi").Cells(i + 4, 7).Select
Selection.Interior.ColorIndex = 34
Selection.Font.Bold = True
Worksheets("Analisi").Cells(i + 6, 6).Select
Selection.Interior.ColorIndex = 35
Selection.Font.Bold = True
Worksheets("Analisi").Cells(i + 6, 7).Select
Selection.Interior.ColorIndex = 35
Selection.Font.Bold = True
Worksheets("Analisi").Cells(i + 2, 6).Select
End If

End Function

Private Sub CommandButton3_Click()
ddt = Worksheets("Analisi").Cells(PosCellaSelezionata, 2).Value
NOME = Worksheets("Analisi").Cells(PosCellaSelezionata, 5).Value
FILEDDT = ddt & " - " & NOME
If FILEDDT <> "" Then
       If Not IsFileOpen("E:GESTIONEDDT 2014" & FILEDDT & ".xls") Then
        Workbooks.Open FileName:="E:GESTIONEDDT 2014" & FILEDDT & ".xls", ReadOnly:=valore
    Else
        MsgBox "Attenzione, il Database Clienti è in uso da un altro utente.", vbCritical
    End If
End If
End Sub

di lepat (utente non iscritto) data: 11/05/2014 09:18:14
non mi intendo di database, ma credo che dovresti allegare il file, non solo il codice
di lepat (utente non iscritto) data: 11/05/2014 09:20:06
inoltre guarda qui h t t p://www.excelvba.it/Forum/thread.php?f=1&t=6323
di Traniwebdesign data: 11/05/2014 09:32:02
no c'è bisogno che posto i ldatabase anche perche è vuoto.........
vorrei sapere le tabelle che devo creare e i campi che devo inserire in questo database che devo creare.
Grazie
di lepat (utente non iscritto) data: 11/05/2014 10:57:00
tu hai detto che il file excel scriveva dei valori nel database, io intendevo allegare il file excel non il database.
di Traniwebdesign data: 12/05/2014 10:08:37
allora file allegato.
database + file excel + vendite giornaliere......
allora
praticamente ogni giorno mi scarico dal mio ebay le vendite..........
con il file excel le importo e creo le schede dei clienti.........
cosi tengo tutto a database...........
ora non mi fa la ricerca storica anche inserendo manualemnte.........
e sopartutto non mi importa piu il csv generato da ebay...........
non so come mai....spero in voi.......
grazie mille a tutti
di lepat (utente non iscritto) data: 12/05/2014 10:31:25
non capisco perché questo controllo
If Right(PercorsoDaAprire, 3) = "rar" Then
se il file da apire è un csv, inoltre il tuo csv ha la prima riga vuota, quindi non funziona
Input #1, elencovariabili
di Traniwebdesign data: 12/05/2014 10:42:01
forse è quello il problema ? estensione del file da aprire ?
di lepat (utente non iscritto) data: 12/05/2014 11:32:27
il codice l'ha fatto tu ? posso modificarlo come mi pare ?
di lepat (utente non iscritto) data: 12/05/2014 11:41:02
Probabilmente è cambiata rispetto a prima la struttura del file csv, il codice cerca il carattere | come separatore, invece i separatori sono le virgole
di Traniwebdesign data: 12/05/2014 13:23:24
vai fai pure............
forse prima c'era il pipe......roba di 2 anni fa..
ora c'è la virgola............
ma da sempre errore.........
modifica pure, se ci riesci ti offro una birra..
di lepat (utente non iscritto) data: 12/05/2014 14:21:59
ho provato, ma la struttura del csv è completamente diversa da quella richiesta dal codice, c'è da rifare tutto daccapo ed io non so qual'è il risultato che ti aspetti una volta letto il csv

di lepat (utente non iscritto) data: 12/05/2014 17:14:53
è possibile leggere il csv con questo codice, basta sapere dove incollare il contenuto

Sub import()
Set wb = ActiveWorkbook
Workbooks.OpenText FileName:= _
        "C:gestioneSalesHistory.csv", Origin:= _
        xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
        , ConsecutiveDelimiter:=False, Tab:=False, semicolon:=False, comma:= _
        True, Space:=False, FieldInfo:=Array(1, 1) _
        , TrailingMinusNumbers:=True
ActiveSheet.UsedRange.Copy wb.Sheets(???).Range("??")
ActiveWorkbook.Close
End Sub

di Traniwebdesign data: 12/05/2014 17:50:11
ho allegato i file alla discussione.
puoi fare una prova.........
perche io di vba ne so veramente poco.........
praticamente dovrebbe leggere solo dove vede il numero vendita.........
dove non ci sono piu numeri vendita dovrebbe fermarsi a leggere....

Vuoi Approfondire?