J
Jay
I want to combine these two components I'd like to have them all work together
to accomplish what I need. Any input from the guru's out there will be
appreciated.
'==============(1)
The first part works like so, it grabs the targeted file(s) and imports
them into a temp table. This works fine, only it creates error againts
the imported text file's first row of data, this, I can get rid of. See code
for section two below:
'---------------------
Private Sub cmdImport_Click()
On Error GoTo Err_cmdImport_Click
'This function generates the start and end times of total seconds or
minutes taken to import a data file.
Dim dteStart As Date
Dim dteEnd As Date
Dim strDataMessage As String
Dim strFile As String
Dim stDocName As String
Dim stLinkCriteria As String
Dim strPath As String
Dim strFullPath As String
Dim x As String
'Here the path to the target folder is set
strPath = "" & Me![txtSourceFile]
If strPath = "" Then Exit Sub
strFullPath = strPath & "*.*"
strFile = Dir(strFullPath)
dteStart = Now()
strDataMessage = "Elapsed Import Time"
Do Until strFile = ""
If Right(strFile, 4) = ".txt" Then
'Start Bulk Excel File Import Process Here. The Do Loop looks
for all file names
'ending in .xls until there are no more to found within the
selected folder. Then, begins the import process
strFullPath = strPath & strFile
SetFileName (Nz(strFile, ""))
ImportWorkBook_To_Temp
Debug.Print strFile
End If
strFile = Dir
Loop
dteEnd = Now()
MsgBox "Start: " & CStr(dteStart) & vbCrLf & " End: " & CStr(dteEnd),
vbInformation, strDataMessage
DoCmd.SetWarnings False
'''DoCmd.RunMacro "mcr_MTSFO_Import"
'''DoCmd.OpenQuery "qry_Appnd_New_ResinTp"
'''DoCmd.OpenQuery "qry_Append_ProductCategories_Item"
DoCmd.SetWarnings True
'''DoCmd.Requery "frm_AlreadyImported_And_Appnd_Files2"
'''DoCmd.OpenForm "frm_DCount_For_Errors_In_TempTables"
'''Forms!frm_DCount_For_Errors_In_TempTables.Visible = False
'This function tests for errors during the import process. If any are
found the user is told to check and_
'correct the error prior to continueing with the append process.
If (Forms!frm_DCount_For_Errors_In_TempTables!txtGrpErrCntsTots > 0) Then
MsgBox "You've Imported Data Which Contained Errors. Please, View
The Error Logs, Correct These Errors And Try Again!", vbCritical, "Data
Errors Found"
End If
If (Forms!frm_DCount_For_Errors_In_TempTables!txtGrpErrCntsTots = 0) Then
'''Me!cmdVwPlntDta.Visible = False
'''Me!cmdAppendData.Visible = True
'AppendAllData
'MsgBox "This Error Free Excel File Was Appended Successfully!"
End If
Me.Repaint
Exit_cmdImport_Click:
Exit Sub
Err_cmdImport_Click:
''MsgBox Err.Description
''Resume Exit_cmdImport_Click
If Err.Number = 3161 Then
MsgBox "The File You've Attempted To Import Has A Workbook
Protection Password Lock Set . Please, Unprotect The WorkBook And Try
Importing Again"
Else
Resume Exit_cmdImport_Click
End If
End Sub
'===============(2)
The second part, which is the new components to this is supposed to trip off
the first ROW of data from each targeted file(s) and only grin into the temp
table the rwas data. I'd really like to combine the two together and
have them work as one unit! Is this possible??? Oh, the target file name
extension can be .Dat or .Txt., .doc, etc, etc, etc! Would it be possible to
have the application simply grab any file with any .Whatever extension. See
code for section three below:
'---------------------------
Function TrimFileHeader( ByVal FileSpec As String, ByVal LinesToTrim As
Long, Optional ByVal BackupExtension As String = "") As Long
'Removes the specified number of lines from the beginning
'of a textfile.
'Optionally leaves the original file with its extension
'changed to BackupExtension.
'Returns 0 on success, otherwise the number of the error.
'By John Nurick, 2004-5
Dim fso As Object 'Scripting.FileSystemObject
Dim fIn As Object 'Scripting.TextStream
Dim fOut As Object 'Scripting.TextStream
Dim fFile As Object 'Scripting.File
Dim strFolder As String
Dim strNewFile As String
Dim strBakFile As String
Dim j As Long
On Error GoTo Err_TrimFileHeader
Set fso = CreateObject("Scripting.FileSystemObject")
With fso
'Handle relative path in Filespec
FileSpec = .GetAbsolutePathName(FileSpec)
strFolder = .GetParentFolderName(FileSpec)
strNewFile = .BuildPath(strFolder, fso.GetTempName)
'Open files
Set fIn = .OpenTextFile(FileSpec, ForReading)
Set fOut = .CreateTextFile(strNewFile, True)
'Dump header
For j = 1 To LinesToTrim
fIn.ReadLine
Next
'Read and write remainder of file
Do While Not fIn.AtEndOfStream
fOut.WriteLine fIn.ReadLine
Loop
fOut.Close
fIn.Close
'Rename or delete old file
If Len(BackupExtension) > 0 Then
strBakFile = .GetBaseName(FileSpec) _
& IIf(Left(BackupExtension, 1) <> ".", ".", "") _
& BackupExtension
If .FileExists(.BuildPath(strFolder, strBakFile)) Then
.DeleteFile .BuildPath(strFolder, strBakFile), True
End If
Set fFile = .GetFile(FileSpec)
fFile.Name = strBakFile
Set fFile = Nothing
Else
.DeleteFile FileSpec, True
End If
'Rename new file
Set fFile = .GetFile(strNewFile)
fFile.Name = .GetFileName(FileSpec)
Set fFile = Nothing
Set fso = Nothing
End With
'normal exit
TrimFileHeader = 0
Exit Function
Err_TrimFileHeader:
TrimFileHeader = Err.Number
End Function
Any assistance on this matter will be appreciated!!!!!!! THANKS.
to accomplish what I need. Any input from the guru's out there will be
appreciated.
'==============(1)
The first part works like so, it grabs the targeted file(s) and imports
them into a temp table. This works fine, only it creates error againts
the imported text file's first row of data, this, I can get rid of. See code
for section two below:
'---------------------
Private Sub cmdImport_Click()
On Error GoTo Err_cmdImport_Click
'This function generates the start and end times of total seconds or
minutes taken to import a data file.
Dim dteStart As Date
Dim dteEnd As Date
Dim strDataMessage As String
Dim strFile As String
Dim stDocName As String
Dim stLinkCriteria As String
Dim strPath As String
Dim strFullPath As String
Dim x As String
'Here the path to the target folder is set
strPath = "" & Me![txtSourceFile]
If strPath = "" Then Exit Sub
strFullPath = strPath & "*.*"
strFile = Dir(strFullPath)
dteStart = Now()
strDataMessage = "Elapsed Import Time"
Do Until strFile = ""
If Right(strFile, 4) = ".txt" Then
'Start Bulk Excel File Import Process Here. The Do Loop looks
for all file names
'ending in .xls until there are no more to found within the
selected folder. Then, begins the import process
strFullPath = strPath & strFile
SetFileName (Nz(strFile, ""))
ImportWorkBook_To_Temp
Debug.Print strFile
End If
strFile = Dir
Loop
dteEnd = Now()
MsgBox "Start: " & CStr(dteStart) & vbCrLf & " End: " & CStr(dteEnd),
vbInformation, strDataMessage
DoCmd.SetWarnings False
'''DoCmd.RunMacro "mcr_MTSFO_Import"
'''DoCmd.OpenQuery "qry_Appnd_New_ResinTp"
'''DoCmd.OpenQuery "qry_Append_ProductCategories_Item"
DoCmd.SetWarnings True
'''DoCmd.Requery "frm_AlreadyImported_And_Appnd_Files2"
'''DoCmd.OpenForm "frm_DCount_For_Errors_In_TempTables"
'''Forms!frm_DCount_For_Errors_In_TempTables.Visible = False
'This function tests for errors during the import process. If any are
found the user is told to check and_
'correct the error prior to continueing with the append process.
If (Forms!frm_DCount_For_Errors_In_TempTables!txtGrpErrCntsTots > 0) Then
MsgBox "You've Imported Data Which Contained Errors. Please, View
The Error Logs, Correct These Errors And Try Again!", vbCritical, "Data
Errors Found"
End If
If (Forms!frm_DCount_For_Errors_In_TempTables!txtGrpErrCntsTots = 0) Then
'''Me!cmdVwPlntDta.Visible = False
'''Me!cmdAppendData.Visible = True
'AppendAllData
'MsgBox "This Error Free Excel File Was Appended Successfully!"
End If
Me.Repaint
Exit_cmdImport_Click:
Exit Sub
Err_cmdImport_Click:
''MsgBox Err.Description
''Resume Exit_cmdImport_Click
If Err.Number = 3161 Then
MsgBox "The File You've Attempted To Import Has A Workbook
Protection Password Lock Set . Please, Unprotect The WorkBook And Try
Importing Again"
Else
Resume Exit_cmdImport_Click
End If
End Sub
'===============(2)
The second part, which is the new components to this is supposed to trip off
the first ROW of data from each targeted file(s) and only grin into the temp
table the rwas data. I'd really like to combine the two together and
have them work as one unit! Is this possible??? Oh, the target file name
extension can be .Dat or .Txt., .doc, etc, etc, etc! Would it be possible to
have the application simply grab any file with any .Whatever extension. See
code for section three below:
'---------------------------
Function TrimFileHeader( ByVal FileSpec As String, ByVal LinesToTrim As
Long, Optional ByVal BackupExtension As String = "") As Long
'Removes the specified number of lines from the beginning
'of a textfile.
'Optionally leaves the original file with its extension
'changed to BackupExtension.
'Returns 0 on success, otherwise the number of the error.
'By John Nurick, 2004-5
Dim fso As Object 'Scripting.FileSystemObject
Dim fIn As Object 'Scripting.TextStream
Dim fOut As Object 'Scripting.TextStream
Dim fFile As Object 'Scripting.File
Dim strFolder As String
Dim strNewFile As String
Dim strBakFile As String
Dim j As Long
On Error GoTo Err_TrimFileHeader
Set fso = CreateObject("Scripting.FileSystemObject")
With fso
'Handle relative path in Filespec
FileSpec = .GetAbsolutePathName(FileSpec)
strFolder = .GetParentFolderName(FileSpec)
strNewFile = .BuildPath(strFolder, fso.GetTempName)
'Open files
Set fIn = .OpenTextFile(FileSpec, ForReading)
Set fOut = .CreateTextFile(strNewFile, True)
'Dump header
For j = 1 To LinesToTrim
fIn.ReadLine
Next
'Read and write remainder of file
Do While Not fIn.AtEndOfStream
fOut.WriteLine fIn.ReadLine
Loop
fOut.Close
fIn.Close
'Rename or delete old file
If Len(BackupExtension) > 0 Then
strBakFile = .GetBaseName(FileSpec) _
& IIf(Left(BackupExtension, 1) <> ".", ".", "") _
& BackupExtension
If .FileExists(.BuildPath(strFolder, strBakFile)) Then
.DeleteFile .BuildPath(strFolder, strBakFile), True
End If
Set fFile = .GetFile(FileSpec)
fFile.Name = strBakFile
Set fFile = Nothing
Else
.DeleteFile FileSpec, True
End If
'Rename new file
Set fFile = .GetFile(strNewFile)
fFile.Name = .GetFileName(FileSpec)
Set fFile = Nothing
Set fso = Nothing
End With
'normal exit
TrimFileHeader = 0
Exit Function
Err_TrimFileHeader:
TrimFileHeader = Err.Number
End Function
Any assistance on this matter will be appreciated!!!!!!! THANKS.