Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

DoCmd.TransferText v2002 with .F16 file type 1

Status
Not open for further replies.

VictoriaLJones

Technical User
May 14, 2003
55
US
Hi,

I have been asked to help with a db conversion from NT & v97 to XP & v2000/2. Prior to converting the db, the team used to import a text file with a .F16 (The exact ending will be determined by the date, so I cannot hard code .F16 as an option) file ending, which is a text file.

However after converting over to XP and 2000/2, it no longer recognises .F16 as a valid file type. The code that has been written is:

DoCmd.TransferText acImportFixed, "DPR Import Specification", "DPR", FileName, False, "" 'Import File base on FileName

I am unfamiliar with this command, and am not sure how to get round it - if we can.

At the moment the option is for me to write a macro (either in Excel or I could call Excel from Access) to convert the file from .F16 to .txt, as Excel does open/recognise the file. However is there a function in Access that could do this, without using Excel, or is there a way to disable this function in access 2000/2.

Any ideas would be great!!!

Thanks in advance!
Victoria
 
If you don't want to go through the process of renaming the files each time you can also edit the registry to recognize .F16 files. What you will need to do in this case is edit the registry key that enables the .F16 extension. The registry path is HKEY_LOCAL_MACHINE\SOFTWARE|Microsoft\Jet\4.0\Engines\Text

Within this you will need to add the F16 extension to the disabled extensions key. The Microsoft bulletin that explains the key to edit is here:
HTH

JR
 
Thanks for that JR.

Can I change the registry to accept a ".***" ending as the F16 denotes a date and it will change daily. Or does each type need to be hard coded.

Thanks
Victoria
 
Victoria,
From the minimal amount of testing I have done it doesn't appear that a *** entry in the registry will allow any text file to be imported. I also tried F** to no avail. It looks like you would need to hard code each possibility, but my suggestion would be to write a function that changes the file to a .txt extension and then import it. I have done something similar, if you need me to post the code I would be more than happy to.

Good Luck,
JR
 
Yes, I think that is the way I will have to go.

Could you please post the code - me being lazy!!

Many thanks for all your help!
Victoria
 
Here is the code that does the file extension in .txt format:

Code:
Function moveAndCopyFile()
'Function moveAndCopyFile() finds the appropriate file, moves it to a new folder to with
'the current date and then creates a copy that is in .txt format to be imported into the
'database, it then calls the import file function to finalize the process and import the files

 Dim fso As FileSystemObject
 'files to transfer and import, if the file names or locations ever change they will need
 'to be changed here
 Dim file1, file2, file3, file4 As String
 file1 = "W:\Corp\ACCT\900020\APPS\VNDERR\rgmmch.dat"
 file2 = "W:\Corp\ACCT\900020\APPS\VNDERR\rgmmus.dat"
 file3 = "W:\Corp\ACCT\900020\APPS\VNDERR\vcbmch.dat"
 file4 = "W:\Corp\ACCT\900020\APPS\VNDERR\vcbmus.dat"

Set fso = CreateObject("Scripting.FileSystemObject")

'Verify files exist
    If Not fso.FileExists(file1) Then
        MsgBox "Files are not there, please verify they are there and try another time.", _
        vbInformation, "File Not Found"
        Exit Function
        
    ElseIf Not fso.FileExists(file2) Then
        MsgBox "Files are not there, please verify they are there and try another time.", _
        vbInformation, "File Not Found"
        Exit Function
        
    ElseIf Not fso.FileExists(file3) Then
        MsgBox "Files are not there, please verify they are there and try another time.", _
        vbInformation, "File Not Found"
        Exit Function
        
    ElseIf Not fso.FileExists(file4) Then
        MsgBox "Files are not there, please verify they are there and try another time.", _
        vbInformation, "File Not Found"
        Exit Function
        
    Else
   
   'Files exist, create folder with the current date
        Dim fsoFolder
        Dim fol As String
        fol = "V:\Corp\ACCT\900220\CC\Post Audit\Download Info\VCB RGM Detail\" _
        & Format(Now, "yyyy-mm-dd")
        
        Set fsoFolder = CreateObject("Scripting.FileSystemObject")
        
        'create folder only if it doesn't already exist
        If Not fso.FolderExists(fol) Then
            fsoFolder.CreateFolder (fol)
        Else
            MsgBox fol & " already exists, this process has already been done!", _
            vbExclamation, "Folder Exists"
            Exit Function
        End If
        
        'move the files into the newly created folder and make a copy in .txt format
        fso.MoveFile file1, fol & "\" & Right(file1, 10)
        fso.copyFile fol & "\" & Right(file1, 10), fol & "\" & "rgmmch.txt"
        fso.MoveFile file2, fol & "\" & Right(file2, 10)
        fso.copyFile fol & "\" & Right(file2, 10), fol & "\" & "rgmmus.txt"
        fso.MoveFile file3, fol & "\" & Right(file3, 10)
        fso.copyFile fol & "\" & Right(file3, 10), fol & "\" & "vcbmch.txt"
        fso.MoveFile file4, fol & "\" & Right(file4, 10)
        fso.copyFile fol & "\" & Right(file4, 10), fol & "\" & "vcbmus.txt"
    End If
    
'call function to do the import portion
importFiles

'delete the .txt files that were created and keep the original .dat files
fso.DeleteFile fol & "\" & "rgmmch.txt"
fso.DeleteFile fol & "\" & "rgmmus.txt"
fso.DeleteFile fol & "\" & "vcbmch.txt"
fso.DeleteFile fol & "\" & "vcbmus.txt"

'log successful import process
logUserAccess

'all processes have completed successfully, notify the user
MsgBox "File Copy and Import Complete", vbInformation, "Process Complete"

End Function

Here is the first part, I will post the import function called above next. I tried both in the same but it wouldn't allow it all.

JR
 
Function importFiles()
'function importFiles() imports the files using the import specs
'because of Access' limitations in regards to importing to linked tables, a local table
'is used to import to, and the data in it is then appended to the linked table

Dim fol As String 'starting folder path
fol = "V:\Corp\ACCT\900220\CC\Post Audit\Download Info\VCB RGM Detail\" _
& Format(Now, "yyyy-mm-dd")

'******************************************************************************************'

'RGM Merch detail

'Delete the information from the previous import
DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE tblRGMMchDetailImport.* FROM tblRGMMchDetailImport")
DoCmd.SetWarnings True

'Import
DoCmd.TransferText acImportFixed, "Rgmmch Import Specification", _
"tblRGMMchDetailImport", fol & "\rgmmch.txt"

'Delete the bad rows that come in from the first 32 rows of the file "XX etc."
DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE tblRGMMchDetailImport.CORP " & _
"FROM tblRGMMchDetailImport WHERE (((tblRGMMchDetailImport.CORP) Is Null))")

'query on the RGM number to ensure that the fields came in at the correct fixed width
Dim rgmMchResult
'should always be 1 if no errors
rgmMchResult = DCount("[Prefix]", "[qryRGMMerchPrefixGroupBy]")

If rgmMchResult = 1 Then
DoCmd.DeleteObject acTable, "rgmmch_ImportErrors" 'delete errors table
Else
MsgBox "There were errors in the conversion of rgmmch.txt, " & _
"check errors table and RGMMch table after import", vbCritical, "Import Errors"
On Error Resume Next
End If

'update vendor id field
DoCmd.OpenQuery "updateVndrIdTblRGMMchDetail"

'append import data to the linked table
DoCmd.RunSQL ("INSERT INTO tblRGMMchDetail ( CORP, RGM_NBR, RGM_DATE, VENDOR_NBR, " & _
"LOC, VENDOR_NAME, VOUCHER, PRO_NUMBER, COMMENT, SKU, QTY, MODEL_STYLE, UNIT_COST, " & _
"EXT_COST, COMMENT2, VNDR_ID )SELECT tblRGMMchDetailImport.CORP, " & _
"tblRGMMchDetailImport.RGM_NBR, tblRGMMchDetailImport.RGM_DATE, " & _
"tblRGMMchDetailImport.VENDOR_NBR,tblRGMMchDetailImport.LOC, " & _
"tblRGMMchDetailImport.VENDOR_NAME, tblRGMMchDetailImport.VOUCHER, " & _
"tblRGMMchDetailImport.PRO_NUMBER, tblRGMMchDetailImport.COMMENT, " & _
"tblRGMMchDetailImport.SKU,tblRGMMchDetailImport.QTY, tblRGMMchDetailImport.MODEL_STYLE, " & _
"tblRGMMchDetailImport.UNIT_COST,tblRGMMchDetailImport.EXT_COST, " & _
"tblRGMMchDetailImport.COMMENT2,tblRGMMchDetailImport.VNDR_ID FROM tblRGMMchDetailImport")

DoCmd.SetWarnings True
'********************************************************************************************'

'RGM Music detail

'Delete the information from the previous import
DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE tblRGMMusDetailImport.* FROM tblRGMMusDetailImport")
DoCmd.SetWarnings True

'Import
DoCmd.TransferText acImportFixed, "Rgmmus Import Specification", _
"tblRGMMusDetailImport", fol & "\rgmmus.txt"

'Delete the bad rows that come in from the first 32 rows of the file "XX etc."
DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE tblRGMMusDetailImport.CORP FROM " & _
"tblRGMMusDetailImport WHERE (((tblRGMMusDetailImport.CORP) Is Null))")

'query on the RGM number to ensure that the fields came in at the correct fixed width
Dim rgmMusResult
'should always be 1 if no errors
rgmMusResult = DCount("[Prefix]", "[qryRGMMusicPrefixGroupBy]")

If rgmMusResult = 1 Then
DoCmd.DeleteObject acTable, "rgmmus_ImportErrors" 'delete errors table
Else
MsgBox "There were errors in the conversion of rgmmus.txt, " & _
"check errors table and RGMMus table after import", vbCritical, "Import Errors"
On Error Resume Next
End If

'update vendor id field
DoCmd.OpenQuery "updateVndrIdTblRGMMusDetail"

'append import data to the linked table
DoCmd.RunSQL ("INSERT INTO tblRGMMusDetail ( CORP, RGM_NBR, RGM_DATE, VENDOR_NBR, LOC, " & _
"VENDOR_NAME, VOUCHER, PRO_NUMBER, COMMENT, SKU, QTY, MODEL_STYLE, UNIT_COST, EXT_COST, UPC, " & _
"VNDR_ID )SELECT tblRGMMusDetailImport.CORP, tblRGMMusDetailImport.RGM_NBR, " & _
"tblRGMMusDetailImport.RGM_DATE, tblRGMMusDetailImport.VENDOR_NBR, tblRGMMusDetailImport.LOC, " & _
"tblRGMMusDetailImport.VENDOR_NAME, tblRGMMusDetailImport.VOUCHER, tblRGMMusDetailImport.PRO_NUMBER, " & _
"tblRGMMusDetailImport.COMMENT, tblRGMMusDetailImport.SKU, tblRGMMusDetailImport.QTY, " & _
"tblRGMMusDetailImport.MODEL_STYLE, tblRGMMusDetailImport.UNIT_COST, tblRGMMusDetailImport.EXT_COST, " & _
"tblRGMMusDetailImport.UPC, tblRGMMusDetailImport.VNDR_ID FROM tblRGMMusDetailImport")

DoCmd.SetWarnings True
'*******************************************************************************************'

'VCB Merch Detail

'Delete the information from the previous import
DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE tblVCBMchDetailImport.* FROM tblVCBMchDetailImport")
DoCmd.SetWarnings True

'Import
DoCmd.TransferText acImportFixed, "Vcbmch Import Specification", _
"tblVCBMchDetailImport", fol & "\vcbmch.txt"

'Delete the bad rows that come in from the first 32 rows of the file "XX etc."
DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE tblVCBMchDetailImport.CORP FROM " & _
"tblVCBMchDetailImport WHERE (((tblVCBMchDetailImport.CORP) Is Null))")

'query on the VCB number to ensure that the fields came in at the correct fixed width
Dim vcbMchResult
'should always be 1 if no errors
vcbMchResult = DCount("[Prefix]", "[qryVCBMchPrefixGroupBy]")

If vcbMchResult = 1 Then
DoCmd.DeleteObject acTable, "vcbmch_ImportErrors" 'delete errors table
Else
MsgBox "There were errors in the conversion of vcbmch.txt, " & _
"check errors table and VCBMch table after import", vbCritical, "Import Errors"
' On Error Resume Next
End If

'update vendor id field
DoCmd.OpenQuery "updateVndrIdTblVCBMchDetail"

'append import data to the linked table
DoCmd.RunSQL ("INSERT INTO tblVCBMchDetail ( CORP, VCB_NBR, VCB_DATE, VENDOR_NBR, LOC, " & _
"VENDOR_NAME, VOUCHER, INVOICE_NUMBER, PO_NUMBER, COMMENT, SKU, QTY, MODEL_STYLE, " & _
"UNIT_COST, EXT_COST, COMMENT2, VNDR_ID )SELECT tblVCBMchDetailImport.CORP, " & _
"tblVCBMchDetailImport.VCB_NBR, tblVCBMchDetailImport.VCB_DATE, " & _
"tblVCBMchDetailImport.VENDOR_NBR, tblVCBMchDetailImport.LOC, " & _
"tblVCBMchDetailImport.VENDOR_NAME, tblVCBMchDetailImport.VOUCHER, " & _
"tblVCBMchDetailImport.INVOICE_NUMBER, tblVCBMchDetailImport.PO_NUMBER, " & _
"tblVCBMchDetailImport.COMMENT, tblVCBMchDetailImport.SKU, tblVCBMchDetailImport.QTY, " & _
"tblVCBMchDetailImport.MODEL_STYLE, tblVCBMchDetailImport.UNIT_COST, " & _
"tblVCBMchDetailImport.EXT_COST, tblVCBMchDetailImport.COMMENT2, " & _
"tblVCBMchDetailImport.VNDR_ID FROM tblVCBMchDetailImport")

DoCmd.SetWarnings True
'********************************************************************************************'

'VCB Music Detail

'Delete the information from the previous import
DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE tblVCBMusDetailImport.* FROM tblVCBMusDetailImport")
DoCmd.SetWarnings True

'Import
DoCmd.TransferText acImportFixed, "Vcbmus Import Specification", _
"tblVCBMusDetailImport", fol & "\vcbmus.txt"

'Delete the bad rows that come in from the first 32 rows of the file "XX etc."
DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE tblVCBMusDetailImport.CORP FROM " & _
"tblVCBMusDetailImport WHERE (((tblVCBMusDetailImport.CORP) Is Null))")

'query on the VCB number to ensure that the fields came in at the correct fixed width
Dim vcbMusResult
'should always be 1 if no errors
vcbMusResult = DCount("[Prefix]", "[qryVCBMusicPrefixGroupBy]")

If vcbMusResult = 1 Then
DoCmd.DeleteObject acTable, "vcbmus_ImportErrors" 'delete errors table
Else
MsgBox "There were errors in the conversion of vcbmus.txt, " & _
"check errors table and VCBMus table after import", vbCritical, "Import Errors"
On Error Resume Next
End If

'update vendor id field
DoCmd.OpenQuery "updateVndrIdTblVCBMusDetail"

'append import data to the linked table
DoCmd.RunSQL ("INSERT INTO tblVCBMusDetail ( CORP, VCB_NBR, VCB_DATE, VENDOR_NBR, " & _
"LOC, VENDOR_NAME, VOUCHER, INVOICE_NUMBER, PO_NUMBER, COMMENT, SKU, QTY, MODEL_STYLE, " & _
"UNIT_COST, EXT_COST, COMMENT2, VNDR_ID ) SELECT tblVCBMusDetailImport.CORP, " & _
"tblVCBMusDetailImport.VCB_NBR, tblVCBMusDetailImport.VCB_DATE, " & _
"tblVCBMusDetailImport.VENDOR_NBR, tblVCBMusDetailImport.LOC, " & _
"tblVCBMusDetailImport.VENDOR_NAME, tblVCBMusDetailImport.VOUCHER, " & _
"tblVCBMusDetailImport.INVOICE_NUMBER, tblVCBMusDetailImport.PO_NUMBER, " & _
"tblVCBMusDetailImport.COMMENT, tblVCBMusDetailImport.SKU, " & _
"tblVCBMusDetailImport.QTY, tblVCBMusDetailImport.MODEL_STYLE, " & _
"tblVCBMusDetailImport.UNIT_COST, tblVCBMusDetailImport.EXT_COST, " & _
"tblVCBMusDetailImport.COMMENT2, tblVCBMusDetailImport.VNDR_ID FROM tblVCBMusDetailImport")

DoCmd.SetWarnings True

End Function

I hope these two can help in some way.

Good Luck,
JR
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top