Hello,
I am trying to make a dts pakage that will upload files from a directoy to a
sql table. Pleases note that the text file is tab delimated. also the name of
the file keeps changeing. Its like i should be able to go through all files
in a certain folder and upload those files to sql table... please help... i
m stuck.

Ok here is a bunch of code...

Some of it might apply and help... I have not realy cleaned it up so sorry
for the extra stuff...

' ================================================== ======================
' === Visual Basic ActiveX Script (6.0)
' === This script imports Assurant files for the following FTP Files
' === Assurant F1 File
' === See Documentation for file F1 format.
' === Last Updated: July 18, 2005 by Warren C. LaFrance, Jr.
' ================================================== ======================



Function Main()

On Error Resume Next


Dim folderspec
Dim folderFileList
Dim fileOperationsErr
Dim operationsErr

folderspec = "\\Server1\c$\Import\download\"
archiveFolder = "\\Server1\c$\Import\download\done\"
errorTrapFolder = "\\Server1\c$\Import\download\ERRORTRAP\"

'Used in case import errors or such happen. Easy to recover incorrect
files this way.

folderFileList = getFileList(folderspec)



Dim itemList
itemList = UBound(folderFileList)
Dim item

For i = 0 to UBound(folderFileList) -1

Dim pathFile
pathFile = folderspec & folderFileList(i)

Dim FileName
FileName = folderFileList(i)

Dim fileContent

' ================================================== ======
' === Begin Code to Parse Each File Type.
' ================================================== ======

fileContent = OpenTextFile(pathFile)

parsedFile = Split(fileContent , "~")

Dim dispatchType



Dim CheckValue
CheckValue = insertFile(parsedFile, Filename)

fileOperationsErr = MoveFile(pathFile, archiveFolder)


Next




Main = DTSTaskExecResult_Success

End Function





Function getFileList(folderspec)
On Error Resume Next
Dim fs ' File System Object
Dim f 'Folder
Dim f1 'File Object
Dim fc 'FileList Container.
Dim s 'Strings for output.
Dim counter
Dim fileListCount
Dim arrFileList()

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
counter = 0
ReDim Preserve arrFileList(f.files.count)
For Each f1 in fc
s = s & f1.name
s = s & vbCrLf
arrfileList(counter) = f1.name
Counter = Counter + 1

Next

getfileList = arrfileList
End Function


Function OpenTextFile(fileToRead)

IF fileToRead <> "" then


Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
If (fs.FileExists(fileToRead)) Then

Set f = fs.OpenTextFile(fileToRead, ForReading,TristateFalseUseDefault)
Dim fileContent

fileContent =CSTR( f.Readall)
f.Close
OpenTextFile = fileContent
End If
End If

End Function

Function insertFile (ByVal parsedFile, ByVal File_Name)

Dim InsertString
Dim DispatchType
DispatchType = parsedFile(0)

' ================================================== =============================
' === The Status will determine the format of the incoming file:
' === NEW and UPDATE will contain all 45 fields.
' === ACKNOWLDEGEMENT, INFO and CANCEL will only contain the First three
fields.
' ================================================== =============================
Dim Status
Dim IncidentID
Dim IncidentComments
Dim PartLaborFlag
Dim FirstName
Dim LastName
Dim Address1
Dim Address2
Dim City
Dim State
Dim ZipCode
Dim ZipCodeExt
Dim Phone
Dim PhoneExt
Dim altPhone
Dim altPhoneExt






Dim ProductLine
Dim NumberOfParts
Dim ClassCode
Dim ClassComments
Dim PartNumber
Dim OEMNumber
Dim PartComments
Dim Manufacturer
Dim ModelNumber
Dim SerialNumber
Dim ContractDate
Dim AssociatedIncident
'New Field?
Dim AssociationCode
Dim RMAReason

Dim WarrantyStatus

Dim ContractNumber
Dim ExpirationDate
Dim ShippingMethod

Dim AuthorizedAmount

Dim ServiceProvider
Dim ServicerID
Dim AuthorizationCode
Dim ContractTypeCode

Dim Retailer
Dim AdditionalAuthorization



Dim LaborWarranty
Dim PartsWarranty



Dim AltPhone2
Dim AltPhoneExt2
Dim AltPhone3

Dim ClassAssociatedIncident
Dim ClassAssociationReason
Dim SPActionNumber
Dim ClassCodeRequester
Dim AANumber
Dim FileName
Dim Memo
Dim ImportDate



If parsedFile(0) = "NEW" Then


Status =Trim(ReMoveExtra( parsedFile(0),15)) ' 1
IncidentID =Trim(RemoveExtra(parsedFile(1), 10)) '2
IncidentComments = Trim(RemoveExtra(parsedFile(2),1500)) '3
PartLaborFlag =Trim(RemoveExtra(parsedFile(3),14)) '4
FirstName = Trim(RemoveExtra(parsedFile(4),30)) '5
LastName = RemoveExtra(parsedFile(5) ,30) '6
Address1 = RemoveExtra(parsedFile(6) ,40) '7
Address2 = RemoveExtra(parsedFile(7),40) '8
City = RemoveExtra(parsedFile(8),30) '9
State =RemoveExtra(parsedFile(9),30) '10
ZipCode =RemoveExtra( parsedFile(10),5) '11
ZipCodeExt =RemoveExtra(parsedFile(11),4) '12
Phone =RemoveExtra(parsedFile(12), 32) '13
PhoneExt = RemoveExtra(parsedFile(13), 10) '14
altPhone = RemoveExtra(parsedFile(14), 32) '15
altPhoneExt = RemoveExtra(parsedFile(15), 10) '16
ProductLine =RemoveExtra(parsedFile(16),50) '17
NumberOfParts = Trim( parsedFile(17)) '18
ClassCode =RemoveExtra(parsedFile(18),100) '19
ClassComments = RemoveExtra(parsedFile(19), 500) '20
PartNumber = RemoveExtra(parsedFile(20),200) '21
OEMNumber =RemoveExtra( parsedFile(21),500) '22
PartComments = RemoveExtra(parsedFile(22),1000) '23
Manufacturer = RemoveExtra(parsedFile(23), 32) '24
ModelNumber = RemoveExtra(parsedFile(24),30) '25
SerialNumber = removeExtra(parsedFile(25),25) '26
ContractDate =CDate(parsedFile(26)) '27
AssociatedIncident = RemoveExtra(parsedFile(27),10) '28 Associated Incident
RMAReason = RemoveExtra(parsedFile(28),30) '29 Associate Code
'30 For Future Use
PartsWarranty = RemoveExtra(parsedFile(30),30) '31 Warranty Status
ContractNumber = RemoveExtra(parsedFile(31),10) '32 Contract Number
ExpirationDate = CDate(parsedFile(32)) '33 Expiration Date
ShippingMethod = RemoveExtra(parsedFile(33),25) '34 Shipping Method

'35 For Future Use
'36 For Future Use
'37 For Future Use
'38 Authorized Amount
ServiceProvider = RemoveExtra(parsedFile(38),20) '39 Service Provider
'40 Servicer ID
'41 Authorizatin Code
'42 Contract Type Code
myRetailer = RemoveExtra(parsedFile(42),4) '43 Retailer
'44 Additional Authorization
'45 Add Authorization Start

LaborWarranty =" "
AltPhone2 = " "
AltPhoneExt2 = " "
AltPhone3 = " "
ClassAssociatedIncident = " "
ClassAssociationReason = " "
SPActionNumber = " "
ClassCodeRequester = " "
AANumber = " "
FileName =RemoveExtra( File_Name,50)
Memo = ""
ImportDate = Now()



' ================================================== ======================
' === Prepare SQL INSERT STRING
' ================================================== ======================

InsertString = "INSERT INTO GEF1 (Status, IncidentID, IncidentComments,
PartLaborFlag, FirstName, LastName, Address1, Address2, City, State, ZipCode,
ZipCodeExt, Phone, PhoneExt, AltPhone, AltPhoneExt, ProductLine,
NumberOfParts, ClassCode, ClassComments, PartNumber, OEMNumber, PartComments,
Manufacturer, ModelNumber, SerialNumber, ContractDate, AssociatedIncident,
RMAReason, LaborWarranty, PartsWarranty, ContractNumber, ExpirationDate,
ShippingMethod, AltPhone2, AltPhoneExt2, AltPhone3, AltPhoneExt3,
ServicerProvider, ClassAssociatedIncident, ClassAssociationReason,
SPActionNumber, ClassCodeRequester, AANumber, AAStart, FileName, Memo,
ImportDate, Retailer) VALUES ('" & Status & "','" & Trim(IncidentID) &
"','" & IncidentComments & "','" & PartLaborFlag & "','" & FirstName &
"','" & LastName & "','" & Address1 & "','" & Address2 & "','" & City &
"','" & State & "','" & ZipCode & "','" & ZipCodeExt & "','" & Phone &
"','" & PhoneExt & "','" & AltPhone & "','" & AltPhoneExt & "','" &
ProductLine & "','" & NumberOfParts & "','" & ClassCode & "','" &
ClassComments & "','" & PartNumber &"','" & OEMNumber & "','" &
PartComments &"','" & Manufacturer & "','" & ModelNumber & "', '" &
SerialNumber & "', '" & ContractDate & "', '" & AssociatedIncident & "', '"
& RMAReason & "', '" & LaborWarranty & "', '" & PartsWarranty & "', '" &
ContractNumber & "', '" & ExpirationDate & "', '" & ShippingMethod & "', '"
& AltPhone2 & "', '" & AltPhoneExt2 & "', '" & AltPhone3 & "', '" &
AltPhoneExt3 & "','" & ServicerProvider & "', '" & ClassAssociatedIncident
& "', '" & ClassAssociationReason & "', '" & SPActionNumber & "', '" &
ClassCodeRequester & "', '" & AANumber & "', '" & AAStart & " ', '" &
FileName & "', '" & Memo & " ','" & ImportDate & "', '" & myRetailer &
"')"

End If

If parsedFile(0) = "UPDATE" Then



Status =Trim(ReMoveExtra( parsedFile(0),15))
IncidentID =Trim(RemoveExtra(parsedFile(1), 10))
IncidentComments = Trim(RemoveExtra(parsedFile(2),1500))
PartLaborFlag =Trim(RemoveExtra(parsedFile(3),14))
FirstName = Trim(RemoveExtra(parsedFile(4),30))
LastName = RemoveExtra(parsedFile(5) ,30)
Address1 = RemoveExtra(parsedFile(6) ,40)
Address2 = RemoveExtra(parsedFile(7),40)
City = RemoveExtra(parsedFile(8),30)
State =RemoveExtra(parsedFile(9),30)
ZipCode =RemoveExtra( parsedFile(10),5)
ZipCodeExt =RemoveExtra(parsedFile(11),4)
Phone =RemoveExtra(parsedFile(12), 32)
PhoneExt = RemoveExtra(parsedFile(13), 10)
altPhone = RemoveExtra(parsedFile(14), 32)
altPhoneExt = RemoveExtra(parsedFile(15), 10)
ProductLine =RemoveExtra(parsedFile(16),50)
NumberOfParts = Trim( parsedFile(17))
ClassCode =RemoveExtra(parsedFile(18),100)
ClassComments = RemoveExtra(parsedFile(19), 500)
PartNumber = RemoveExtra(parsedFile(20),200)
OEMNumber =RemoveExtra( parsedFile(21),500)
PartComments = RemoveExtra(parsedFile(22),1000)
Manufacturer = RemoveExtra(parsedFile(23), 32)
ModelNumber = RemoveExtra(parsedFile(24),30)
SerialNumber = removeExtra(parsedFile(25),25)

ContractDate =CDate(parsedFile(26))

AssociatedIncident = RemoveExtra(parsedFile(27),10)
RMAReason = ""
LaborWarranty =RemoveExtra( parsedFile(29),30)
PartsWarranty = RemoveExtra(parsedFile(30),30)
ContractNumber = RemoveExtra(parsedFile(31),10)

ExpirationDate = CDate(parsedFile(32))


ShippingMethod = RemoveExtra(parsedFile(33),25)
AltPhone2 = " "
AltPhoneExt2 = " "
AltPhone3 = " "
ServiceProvider = " "
ClassAssociatedIncident = RemoveExtra(parsedFile(39),10)
ClassAssociationReason = " "
SPActionNumber = " "
ClassCodeRequester = " "



AANumber = " "
FileName =RemoveExtra( File_Name,50)
Memo = ""
ImportDate = Now()

myRetailer = RemoveExtra(parsedFile(42),4)

' ================================================== ======================
' === Prepare SQL INSERT STRING
' ================================================== ======================

InsertString = "INSERT INTO GEF1(Status, IncidentID, IncidentComments,
PartLaborFlag, FirstName, LastName, Address1, Address2, City, State, ZipCode,
ZipCodeExt, Phone, PhoneExt, AltPhone, AltPhoneExt, ProductLine,
NumberOfParts, ClassCode, ClassComments, PartNumber, OEMNumber, PartComments,
Manufacturer, ModelNumber, SerialNumber, ContractDate, AssociatedIncident,
RMAReason, LaborWarranty, PartsWarranty, ContractNumber, ExpirationDate,
ShippingMethod, AltPhone2, AltPhoneExt2, AltPhone3, AltPhoneExt3,
ServicerProvider, ClassAssociatedIncident, ClassAssociationReason,
SPActionNumber, ClassCodeRequester, AANumber, AAStart, FileName, Memo,
ImportDate, Retailer) VALUES ('" & Status & "','" & Trim(IncidentID) &
"','" & IncidentComments & "','" & PartLaborFlag & "','" & FirstName &
"','" & LastName & "','" & Address1 & "','" & Address2 & "','" & City &
"','" & State & "','" & ZipCode & "','" & ZipCodeExt & "','" & Phone &
"','" & PhoneExt & "','" & AltPhone & "','" & AltPhoneExt & "','" &
ProductLine & "','" & NumberOfParts & "','" & ClassCode & "','" &
ClassComments & "','" & PartNumber &"','" & OEMNumber & "','" &
PartComments &"','" & Manufacturer & "','" & ModelNumber & "', '" &
SerialNumber & "', '" & ContractDate & "', '" & AssociatedIncident & "', '"
& RMAReason & "', '" & LaborWarranty & "', '" & PartsWarranty & "', '" &
ContractNumber & "', '" & ExpirationDate & "', '" & ShippingMethod & "', '"
& AltPhone2 & "', '" & AltPhoneExt2 & "', '" & AltPhone3 & "', '" &
AltPhoneExt3 & "','" & ServicerProvider & "', '" & ClassAssociatedIncident
& "', '" & ClassAssociationReason & "', '" & SPActionNumber & "', '" &
ClassCodeRequester & "', '" & AANumber & "', '" & AAStart & " ', '" &
FileName & "', '" & Memo & " ','" & ImportDate & "', '" & myRetailer &
"')"


'End of Copied Code


End If

If DispatchType = "ACKNOWLEDGEMENT" or DispatchType = "ACKNOWLEDGEMENT" Then

Status = RemoveExtra(parsedFile(0),15)

IncidentID =RemoveExtra(parsedFile(1), 10)

IncidentComments = RemoveExtra(parsedFile(2),1500)

ImportDate = Now()

InsertString = "INSERT INTO GEF1(Status, IncidentID,
IncidentComments,ImportDate) VALUES ('" & Status & "','" & IncidentID &
"','" & IncidentComments & "','" & ImportDate & "')"


End If

If DispatchType = "INFO" Then

Status =ReMoveExtra( parsedFile(0),15)

IncidentID =RemoveExtra(parsedFile(1), 10)

IncidentComments = RemoveExtra(parsedFile(2),1500)
ImportDate = Now()

InsertString = "INSERT INTO GEF1(Status, IncidentID,
IncidentComments,ImportDate) VALUES ('" & Status & "','" & IncidentID &
"','" & IncidentComments & "','" & ImportDate & "')"

End If

If DispatchType = "CANCEL" Then

Status =ReMoveExtra( parsedFile(0),15)

IncidentID =RemoveExtra(parsedFile(1), 10)

IncidentComments = RemoveExtra(parsedFile(2),1500)
ImportDate = Now()

InsertString = "INSERT INTO GEF1(Status, IncidentID,
IncidentComments,ImportDate) VALUES ('" & Status & "',' " & IncidentID
& "',' " & IncidentComments & "',' " & ImportDate & "')"

End If


' ==========================================
' === Call Insert into Database
' ==========================================

Dim returnCode
returnCode = insertDataGEF1(InsertString)

End Function

Function InsertDataGEF1(InsertString)

' ================================================== =======================
' === Submit Data to Database table GEF1
' ================================================== =======================
' ===
' === Prepare Database Connection and insertion of info.
' ===
' ================================================== ======================

Set ADOcon = CreateObject("ADODB.Connection")
Set ADOrst = CreateObject("ADODB.Recordset")
ADOcon.Open "Warranty"

Dim sErrDesc

On Error Resume Next

If ADOCon.State = 0 Then
sErrDesc = "Failed to Connect"
ReportError(sErrDesc)
Else

ADOCon.Execute (InsertString)

End If


' Get the ADO errors.
If AdoCon.Errors.Count > 0 Then

'For intLoop = 0 To AdoCon.Errors.Count -1
'reportError(adoCon.Errors(intLoop).Number & " --" &
adoCon.Errors(intLoop).Description & "---")
'Next
End If
If ADOCon.Errors.Count > 0 Then
'For Each erCur In ADOCon.Errors
' sErrDesc = sErrDesc & erCur.Source & ": " & erCur.Description
& vbCrLf
' ReportErrors(sErrDesc)

' Next
Else
sErrDesc = ""
End If


ADOcon.Close
Set ADOcon = Nothing



InsertDataGEF1 = sErrDesc

End Function

Public Function removeExtra(ByVal str, ByVal strLenght)
' ============================================
' === Removes extra characters from a str.
' === str, is the string you wish to cleanup.
' === strlength, is the total length allowed
' ============================================
If Not str ="" Then
Dim strRemoving
strRemoving = Trim(str)

If Len(str) > strLenght Then
str = Mid(str,1,strlength)
End If
End If


If InStr(str, "'") <> 0 Then
str = Replace(str, "'", " ")

End If

removeExtra = str

End Function


Function ReportError(InString)
' =============================================
' === ERROR LOGGING
' =============================================

Set fs = CreateObject("Scripting.FileSystemObject")

Dim errorTrapFolder
errorTrapFolder = "\\servr1\c$\import\download\ERRORTRAP\"
errorTrapFileName = "DOWNLOAD_LOG.TXT"
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8

If (fs.FileExists(errorTrapFolder & errorTrapFileName)) Then



Set f = fs.OpenTextFile (errorTrapFolder & errorTrapFileName, ForAppending,
True)

f.Writeline ("Error Report: " & Now() & " -- " & InString & " -- " &
"-----------")
f.Close

Else

Set f = fs.CreateTextFile(errorTrapFolder & errorTrapFileName, True)

Set f = fs.OpenTextFile (errorTrapFolder & errorTrapFileName, ForAppending,
True)
f.Writeline ("Error Report: " & Now() & " -- " & InString & " -- " &
Char(13))
f.Close


End If

fs = Nothing

End Function

Function MoveFile(FileToMove,destination)

' =============================================
' === Moves files that have successfully imported
' =============================================

On Error Resume Next


Dim fs

Set fs = CreateObject("Scripting.FileSystemObject")

fs.MoveFile FileToMove, destination

MoveFile = "Done"

End Function

Function DeleteFinished(FileToDelete)

' ==============================================
' === Deletes Successfully imported Files.
' ==============================================
'This functionality is not needed at this time.


End Function

Is that something i have to put it in DTS???


"Warren" wrote:

Yeah, it is a activeX task...



"Anjum" wrote:

I posted all of that code so you could get an idea of the various methods to
accomplish this task... There are other ways to approach this... Take what
you need from the various parst fo the code and good luck..



"Anjum" wrote:

Would this work?

Looping, Importing and Archiving
(http://www.sqldts.com/default.aspx?246)

Allan

"Anjum" <Anjum (AT) discussions (DOT) microsoft.com> wrote