Ինչպես արտահանել հարցման արդյունքները մուտքի VBA- ով մի քանի ֆայլերի

Microsoft Access- ից տեղեկատվության արտահանումն աներևակայելի հեշտ է. Ենթադրենք, որ ցանկանում եք ստեղծել միայն մեկ արտահանման ֆայլ: Բայց ի՞նչ եք անում, երբ անհրաժեշտ է հարցում (կամ աղյուսակ) բաժանել արտահանման բազմաթիվ ֆայլերի: Օրինակ, եթե ձեզ հարկավոր է ամեն ամիս արտահանել հաճախորդների գործարքների ցուցակ. Յուրաքանչյուր հաճախորդ ունի՞ իր արտահանման գործը: Հենց այդ հոդվածը կարող է օգնել ձեզ: 2, 10 կամ հարյուր տարբեր արտահանման արտահանումն արտադրելը նույնքան պարզ կլինի, որքան VBA կոդի մի փոքր հատվածի գործարկումն ու աշխատանքը կավարտվի վայրկյանների ընթացքում, այլ ոչ թե ձեռքով կտրելու / կպցնելու ժամերի: Այսպիսով, եկեք սկսենք

Մոտեցումը

Քանի որ մենք ուզում ենք, որ սա հնարավորինս ճկուն և օգտագործելի լինի, այս հոդվածի ծածկագիրը սովորականից մի փոքր ավելի երկար կլինի, բայց ինչու կտեսնեք շուտով:

Նախ `ուրվագծենք այն, ինչին ուզում ենք հասնել:

Հաշվի առնելով հարցումը, ամեն անգամ թողարկեք նոր ֆայլ, յուրաքանչյուր անգամ, երբ որոշակի դաշտում փոխվում է մի արժեք:

Մարտահրավեր

Դա անելու համար մենք պետք է կարողանանք քայլ առ քայլ դիտել հարցման արդյունքները՝ համեմատելով ընթացիկ տողի համապատասխան դաշտը նախորդ տողի արժեքի հետ, և եթե դրանք տարբեր են, ստեղծենք նոր ֆայլ և սկսենք արտածել հարցման արդյունքները այնտեղ։

Ինչի համար դա հարմար չէ

Ինչպես արդեն նշեցի, կան բազմաթիվ պատճառներ, թե ինչու եք ցանկանում արտահանել ձեր տվյալների շտեմարանի մասեր, բայց այն որպես պահուստավորման / արխիվացման ձև օգտագործելը դրանցից մեկը չէ, իհարկե ոչ այն մոտեցմամբ, որը ես օգտագործելով այստեղ ՝ վերջին բանը, որ ցանկանում եք անել, եթե բախվում եք վերականգնել a կոռումպացված MDB տվյալների բազա մշակում է, թե ինչպես շատ արտահանումներ միասին միացնել:

Լուծումը:

Կատվի մորթից ազատվելու բազմաթիվ եղանակներ միշտ կան, բայց սա ընդամենը մեկն է, բայց կարծում եմ՝ բավականին լավ է աշխատում։ Նախ, մենք հարցումը կկարդանք զանգվածի մեջ՝ տեղաշարժը հեշտացնելու համար։ Հաջորդը, մենք կանցնենք այդ զանգվածի միջով՝ ստուգելով, թե արդյոք համապատասխան դաշտում նոր արժեք ենք գտել, թե ոչ։ Եթե դա նոր արժեք չէ, մենք ամբողջ գրառումը կարտածենք գրվող ընթացիկ ֆայլում, եթե այն նոր է, մենք կփակենք այդ ֆայլը և կբացենք նորը։

Եվ ծածկագիրը

Sub DoExport(fieldName As String, queryName As String, filePath As String, Optional delim As Variant = vbTab)
    Dim db As Database
    Dim objRecordset As ADODB.Recordset
    Dim qdf As QueryDef
    
    Dim fldcounter, colno, numcols As Integer
    Dim numrows, loopcount As Long
    Dim data, fs, fwriter As Variant
    Dim fldnames(), headerString As String
    
    'get details of the query we'll be exporting
    Set objRecordset = New ADODB.Recordset
    Set db = CurrentDb
    Set qdf = db.QueryDefs(queryName)
    
    'load the query into a recordset so we can work with it
    objRecordset.Open qdf.SQL, CurrentProject.Connection, adOpenDynamic, adLockReadOnly
    
    'load the recordset into an array
    data = objRecordset.GetRows
    
    'close the recordset as we're done with it now
    objRecordset.Close
    
    'get details of the size of array, and position of the field we're checking for in that array
    colno = qdf.Fields(fieldName).OrdinalPosition
    numrows = UBound(data, 2)
    numcols = UBound(data, 1)
    
    
    'as we'll need to write out a header for each file - get the field names for that header
    'and construct a header string
    ReDim fldnames(numcols)
    For fldcounter = 0 To qdf.Fields.Count - 1
        fldnames(fldcounter) = qdf.Fields(fldcounter).Name
    Next
    headerString = Join(fldnames, delim)
    
    'prepare the file scripting interface so we can create and write to our file(s)
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    'loop through our array and output to the file
    For loopcount = 0 To numrows
        If loopcount > 0 Then
            If data(colno, loopcount) <> data(colno, loopcount - 1) Then
                If Not IsEmpty(fwriter) Then fwriter.Close
                Set fwriter = fs.createTextfile(filePath & data(colno, loopcount) & ".txt", True)
                fwriter.writeline headerString
                writetoFile data, queryName, fwriter, loopcount, numcols
            Else
                writetoFile data, delim, fwriter, loopcount, numcols
            End If
        Else
            Set fwriter = fs.createTextfile(filePath & data(colno, loopcount) & ".txt", True)
            fwriter.writeline headerString
            writetoFile data, delim, fwriter, loopcount, numcols
        End If
    Next
    
    'tidy up after ourselves
    fwriter.Close
    Set fwriter = Nothing
    Set objRecordset = Nothing
    Set db = Nothing
    Set qdf = Nothing

End Sub


'parameters are passed "by reference" to prevent moving potentially large objects around in memory
Sub writetoFile(ByRef data As Variant, ByVal delim As Variant, ByRef fwriter As Variant, ByVal counter As Long, ByVal numcols As Integer)
    Dim loopcount As Integer
    Dim outstr As String
    
    For loopcount = 0 To numcols
        outstr = outstr & data(loopcount, counter)
        If loopcount < numcols Then outstr = outstr & delim
    Next
    fwriter.writeline outstr
End Sub

Ինչ է անում ծածկագիրը ՝ առանցքային կետեր

Ես մեկնաբանություններ եմ ավելացրել կոդին գրեթե բոլոր կարևոր տեղերում, բայց դեռ կան մի քանի բաներ, որոնք արժե ընդգծել։

Առաջին. Մենք կոդը բաժանել ենք երկու ռեժիմի: Առաջինն ստուգում է ՝ արդյո՞ք ընթացիկ գրառումը պետք է գրվի նույն ֆայլում, որի վրա մենք այժմ աշխատում ենք, կամ արդյոք այն պետք է գրվի նոր ֆայլում: Երկրորդ ռեժիմը ամբողջ գրառման մանրամասները դուրս է բերում ֆայլ: Դա արվել է այս եղանակով ՝ կոդի կրկնօրինակումը կրճատելու համար, հակառակ դեպքում կտեսնեիք, որ շատ տեղերում տեղի է ունենում նույն օղակը:

Երկրորդ. Ես օգտագործում եմ «Հարցման սահմանումը» ՝ մանրամասներ ստանալու համար այն հարցման վերաբերյալ, որի դեմ մենք աշխատում ենք. Եթե ցանկանում եք հարմարեցնել սա սեղանների հետ աշխատելու համար, ապա կանդրադառնաք փոխանակմանը այնպես, որ այն օգտագործի « Փոխարեն աղյուսակի սահմանում »:

Այս ասելով, ես բավականին վստահ եմ, որ սա մի փոքր ծածկագիր է, որին դուք կվերաբերեք և շատ կօգտագործեք:

Հեղինակի ներածություն.

Mitchell Pond- ը տվյալների վերականգման փորձագետ է DataNumen, Inc., որը տվյալների վերականգման տեխնոլոգիաների համաշխարհային առաջատարն է, այդ թվում նորոգում SQL Server տվյալներ և գերազանցել վերականգնման ծրագրային արտադրանքները: Լրացուցիչ տեղեկությունների համար այցելեք www.datanumen.com