Ақпаратты Microsoft Access-тен экспорттау өте оңай, егер сіз тек бір экспорттық файл жасағыңыз келсе. Сұранысты (немесе кестені) бірнеше экспорттық файлға бөлу қажет болғанда не істейсіз? Мысалы, сізге ай сайын клиенттермен жүргізілетін транзакциялардың тізімін экспорттау қажет болса - әр клиенттің өзінің жеке экспорты бар ма? Бұл жерде сізге осы мақала көмектесе алады. Экспортты 2, 10 немесе жүз түрлі экспорттау VBA кодының кішкене үзіндісін іске қосу сияқты қарапайым болады және жұмыс қолмен кесу / қою сағаттарымен емес, бірнеше секундта аяқталады. Сонымен бастайық ...
Тәсіл
Біз мұны мүмкіндігінше икемді және ыңғайлы болғанын қалаймыз, бұл мақаланың коды әдеттегіден сәл ұзағырақ болады, бірақ сіз мұның себебін жақын арада көресіз.
Біріншіден, қол жеткізгіміз келетін нәрсені атап өтейік:
Сұранысты ескере отырып, көрсетілген өрістегі мән өзгерген сайын жаңа файл шығарыңыз.
Мәселе
Ол үшін біз сұрау нәтижелерін кезең-кезеңімен қарап шығуымыз керек, ағымдағы жолдағы тиісті өрісті алдыңғы жолдағы мәнмен салыстыруымыз керек – егер олар әртүрлі болса, жаңа файл жасап, сол жерде сұрау нәтижелерін шығара бастауымыз керек.
Бұл неге сәйкес келмейді
Мен айтып өткенімдей, сіздің мәліметтер базаңыздың бөліктерін экспорттағыңыз келетін көптеген себептер бар, бірақ оны сақтық көшірме / мұрағаттық мақсат ретінде пайдалану олардың бірі емес, әрине мұнда пайдалану - а қалпына келтіру алдында тұрған соңғы нәрсе 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
Код не істеп жатыр - маңызды сәттер
Мен кодқа көптеген негізгі жерлерде түсініктемелер қостым, бірақ әлі де атап өтуге тұрарлық бірнеше нәрсе бар.
Біріншіден, біз кодты екі тәртіпке бөлдік. Біріншісі, ағымдағы жазбаны біз қазір жұмыс істеп жатқан файлға жазу керек пе, әлде жаңа файлға жазу керек пе, соны тексереді. Екінші режим файлға бүкіл жазбаның мәліметтерін шығарады. Кодтағы қайталануды азайту үшін осылай жасалды, әйтпесе сіз көптеген жерлерде бірдей цикл болып жатқанын көресіз.
Екіншіден, біз өзіміз жұмыс жасайтын сұраныс туралы мәлімет алу үшін «Сұраныстың анықтамасын» қолданамын - егер сіз мұны кестелермен жұмыс істеуге бейімдеуді қаласаңыз, сіз оны « Кесте анықтамасы »орнына.
Сонымен, мен сізге бұл сілтеме жасайтын және көп қолданатын кодтың жеткілікті екеніне сенімдімін!
Автордың кіріспесі:
Митчелл Понд - деректерді қалпына келтіру бойынша сарапшы DataNumen, Соның ішінде деректерді қалпына келтіру технологиялары бойынша әлемдік көшбасшы болып табылатын Inc. жөндеу SQL Server мәліметтер және excel қалпына келтіру бағдарламалық жасақтама өнімдері. Қосымша ақпарат алу үшін кіріңіз WWW.datanumen.com