I have this SSIS script task code copied from a site. I'm trying to avoid FTP failed error when the folder is empty. Does not need to a specific name file. The code below is for specific filename. How to make the filename a wildcard?
Public Sub Main()
Dim StrFolderArrary As String()
Dim StrFileArray As String()
Dim fileName As String
Dim RemoteDirectory As String
RemoteDirectory = Dts.Variables("User::RemoteFolder").Value.ToString()
Dim cm As ConnectionManager = Dts.Connections("FTPConnection") 'FTP connection manager name
Dim ftp As FtpClientConnection = New FtpClientConnection(cm.AcquireConnection(Nothing))
ftp.Connect() 'Connecting to FTP Server
ftp.SetWorkingDirectory(RemoteDirectory) 'Provide the Directory on which you are working on FTP Server
ftp.GetListing(StrFolderArrary, StrFileArray) 'Get all the files and Folders List
'If there is no file in the folder, strFile Arry will contain nothing, so close the connection.
If StrFileArray Is Nothing Then
MessageBox.Show(Dts.Variables("User::Flag").Value.ToString())
ftp.Close()
Dts.Variables("User::Flag").Value = 0
'If Files are there, Loop through the StrFileArray arrary and insert into table
Else
For Each fileName In StrFileArray
MessageBox.Show(fileName)
If fileName = Dts.Variables("User::FileName").Value.ToString() Then
Dts.Variables("User::Flag").Value = 1
MessageBox.Show(Dts.Variables("User::Flag").Value.ToString())
End If
Next
ftp.Close()
End If
' Add your code here
'
Dts.TaskResult = ScriptResults.Success
End Sub
first it is better to add the following Validation to the If statment:
If StrFileArray Is Nothing OrElse _
StrFileArray.length = 0 Then
Filter using Linq (need to import System.Linq)
If StrFileArray.Where(Function(x) x.equals(Dts.Variables("User::FileName").Value)).ToList().Count() > 0 Then
Dts.Variables("User::Flag").Value = 1
End If
UPDATE `
After reading your comment
If StrFileArray.Where(Function(x) x.StartsWith("Abc") AndAlso x.EndsWith(".txt")).ToList().Count() > 0 Then
Dts.Variables("User::Flag").Value = 1
End If
Related
I am using SSIS to load data from Excel 2013 to SQL Server 2014. One column has data that exceeds 255 char. Using the source Excel task will only read the first 255 char truncating the rest.
I wrote a .vb script to open the file and save it as a csv while also keeping all of the char past 255, however i have not found how to make a specified sheet active before saving it as a csv file.
I decided to convert the code to VB.Net using Microsoft.Office.Interop.Excel to access the file, however I still have a problem getting the right syntax. I cannot find anything for VB.Net using Microsoft.Office.Interop.Excel.
Public Sub Main()
Dim FilePath As String = "I:\DSS Clarity\Clarity Technical\METADATA MINING\INPUT_SAP_BO_UNIVERSE_FILES\"
Dim FileName As String = "UNV Universes.xlsx"
Dim excel As Microsoft.Office.Interop.Excel.Application = New Microsoft.Office.Interop.Excel.Application
excel.DisplayAlerts = False
' Open Excel spreadsheet.
Dim wb As Workbook
wb = excel.Workbooks.Open(FilePath & FileName)
'wb.Worksheets.Select("Tables") <-- need to make the Tables sheet active - how do i do that?
wb.SaveAs(FilePath & Left(FileName, InStrRev(FileName, ".")) & "csv", 24)
wb.Close()
Dts.TaskResult = ScriptResults.Success
End Sub
I am expecting to see all of the data for a specified sheet saved in csv format, not just the excel constraint of max 255 char for one field.
I made the following edits to your code:
I selected the first worksheet before saving
I edited the SaveAs() function parameters
You must Close the application using excel.Quit() command at the end of the script
Public Sub Main()
Dim FilePath As String = "I:\DSS Clarity\Clarity Technical\METADATA MINING\INPUT_SAP_BO_UNIVERSE_FILES\"
Dim FileName As String = "UNV Universes.xlsx"
Dim excel As Microsoft.Office.Interop.Excel.Application = New Microsoft.Office.Interop.Excel.Application
excel.DisplayAlerts = False
' Open Excel spreadsheet.
Dim wb As Workbook
wb = excel.Workbooks.Open(FilePath & FileName)
wb.Worksheets(0).Select(Type.Missing) 'Or try wb.Worksheets(0).Select()
wb.SaveAs(FilePath & Left(FileName, InStrRev(FileName, ".")) & "csv", Excel.XlFileFormat.xlCSV,Excel.XlSaveAsAccessMode.xlNoChange)
wb.Close(false)
excel.Quit()
Dts.TaskResult = ScriptResults.Success
End Sub
I am trying to query a database using Excel VBA and write to a sheet. The VBA code I have works fine for one server/database, but when I try to pull from a different database it messes up.
When I run this on this database, I get an error stating "Operation is not allowed when object is closed." on With mrs line. I don't understand why the object is closed when I opened it two lines before.
SQL query has nocount on and ansi_warnings off.
Here is the associated VBA Code:
Dim strFileContent As String
Dim massiveString As String
Sub runSelectedQueries()
Call runQuery(Sheet3, "dbp07", "OLBRET", "C:\Queries\query.sql")
End Sub
Private Sub runQuery(outputSheet As Worksheet, serverVar As String, databaseVar As String, queryLoc As String)
Dim sSQLQry As String
Dim ReturnArray
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
Dim DBPath As String, sconnect As String
sconnect = "Provider=SQLOLEDB;driver={SQL Server}; server=" & serverVar & "; Integrated Security=SSPI; database=" & databaseVar & ";"
MsgBox (sconnect)
'run readFile sub
readAnyFile (queryLoc)
'parse SQL file into string
sSQLString = massiveString
Conn.Open sconnect
mrs.Open sSQLString, Conn
'write in the master record set (mrs) into a sheet
With mrs
For i = 1 To .Fields.Count
outputSheet.Cells(1, i) = .Fields(i - 1).Name
Next i
End With
outputSheet.Range("A2").CopyFromRecordset mrs
'Close Recordset
mrs.Close
'Close Connection
Conn.Close
End Sub
'reads any file as input (text) not binary using EOF, stripping the metadata at begining of a file
Sub readAnyFile(queryLoc As String)
Dim FileNum As Integer
Dim DataLine As String
massiveString = ""
FileNum = FreeFile()
Open queryLoc For Input As #FileNum
While Not EOF(FileNum)
Line Input #FileNum, DataLine ' read in data 1 line at a time
massiveString = massiveString + DataLine
Wend
massiveString = Right(massiveString, Len(massiveString) - 2)
MsgBox ("Read Successfully")
MsgBox (massiveString)
End Sub
When I debug and push out the SQL code that is read from a file, I get exactly what is in SQL Server Management Studio. The SQL statement runs fine in MS Query, Python and SQL Server Management Studio as parsed by VBA so I don't think that's the issue but I could post it.
I am trying to accomplish a simple task of merging PDF files to one PDF. And I want the resulting PDF file to have Bookmarks to each file from the filename. And preferably i would like to have a free solution for this.
I am on a windows system and want to execute this from either command line or even better from MSSQL.
The thing is that i will create PDF files of orders from an ERP system with Crystal Reports. An stored procedure will create these PDF files. After that i want to take selected PDFs and create a new merged PDF of those and the merged PDF should have each order number (from the filename) as a bookmark. So that you easily can jump to an order number if you are searching for a specific one.
And as I said preferably free solutions, if not available I am ready to code my own merge program in for example C# or similar.
I think you would need Adobe Acrobat for this, at a bare minimum. Or, if you don't have that and you don't want to pay for it, you can convert all PDFs to TXT files, and merge all TXT files. This sounds a bit cumbersome, but actually, the easiest thing to do . . . maybe . . . is to convert all those TXT files into Excel files, and merge those. That shouldn't be hard at all. Here is a script to convert all TXT files into Excel files.
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Public Function ChDirNet(szPath As String) As Boolean
'based on Rob Bovey's code
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
ChDirNet = CBool(lReturn <> 0)
End Function
Sub Get_TXT_Files()
'For Excel 2000 and higher
Dim Fnum As Long
Dim mysheet As Worksheet
Dim basebook As Workbook
Dim TxtFileNames As Variant
Dim QTable As QueryTable
Dim SaveDriveDir As String
Dim ExistFolder As Boolean
'Save the current dir
SaveDriveDir = CurDir
'You can change the start folder if you want for
'GetOpenFilename,you can use a network or local folder.
'For example ChDirNet("C:\your_path_here\")
'It now use Excel's Default File Path
ExistFolder = ChDirNet("C:\your_path_here\\Text\")
If ExistFolder = False Then
MsgBox "Error changing folder"
Exit Sub
End If
TxtFileNames = Application.GetOpenFilename _
(filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True)
If IsArray(TxtFileNames) Then
On Error GoTo CleanUp
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Add workbook with one sheet
Set basebook = Workbooks.Add(xlWBATWorksheet)
'Loop through the array with txt files
For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames)
'Add a new worksheet for the name of the txt file
Set mysheet = Worksheets.Add(After:=basebook. _
Sheets(basebook.Sheets.Count))
On Error Resume Next
mysheet.Name = Right(TxtFileNames(Fnum), Len(TxtFileNames(Fnum)) - _
InStrRev(TxtFileNames(Fnum), "\", , 1))
On Error GoTo 0
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & TxtFileNames(Fnum), Destination:=Range("A1"))
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
'This example use xlDelimited
'See a example for xlFixedWidth below the macro
.TextFileParseType = xlDelimited
'Set your Delimiter to true
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
'Set the format for each column if you want (Default = General)
'For example Array(1, 9, 1) to skip the second column
.TextFileColumnDataTypes = Array(1, 9, 1)
'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9
' Get the data from the txt file
.Refresh BackgroundQuery:=False
End With
ActiveSheet.QueryTables(1).Delete
Next Fnum
'Delete the first sheet of basebook
On Error Resume Next
Application.DisplayAlerts = False
basebook.Worksheets(1).Delete
Application.DisplayAlerts = True
On Error GoTo 0
CleanUp:
ChDirNet SaveDriveDir
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub
Currently have a working script that uses FSO, but it also opens .xlsm files within my working directory. I would like to to only open .txt files.
I found this code that should work, however I can't figure out how to apply it to my situation:
Sub test()
' Loop thru all files in the folder
folder = ActiveWorkbook.path
path = folder & "\*.txt"
Filename = Dir(path)
Do While Filename <> ""
'insert other functions here
Loop
End Sub
My Code (Works, but also opens .xlsm files, which I don't want it to do):
Option Explicit
Sub Initialize_barcode_lookup_Array_test()
Dim fso As FileSystemObject
Dim folder As String, path As String, count_txt_files As Long, Filename As String
Dim folder2 As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim ShippingPlanArray() As String
Dim i As Long, j As Long, k As Long
Dim cl As Range
Dim fName
Dim row As Long, column As Long
Dim shipping_plan As Long 'Number of shipping plans text files imported
Dim barcode_Lookup() As String
Dim lastRow As Long
Dim longest_lastRow As Long
Dim counter As Long
Dim FNSKU_Input As String
'<<<< Creating FSO Object >>>>>
'Define longest_lastRow
longest_lastRow = 0
'Define i (References the text file open)
i = 0
' Get a FileSystem object
Set fso = New FileSystemObject
' get the directory you want
Set folder2 = fso.GetFolder(ActiveWorkbook.path)
' Loop only while the files being opened are .txt files:
For Each file In folder2.Files
row = 0
column = 0
Set FileText = file.OpenAsTextStream(ForReading)
Do Until FileText.AtEndOfStream
fName = FileText.ReadLine
'Parse data by tabs (text-tab delimited) into Items() array
Items() = Split(fName, vbTab)
' Redimension Preserve the ShippingPlanArray()
' NOTE: You can only Redimension preserve the last dimension of a multi-dimensional array
' (In this case: row)
ReDim Preserve ShippingPlanArray(9, row)
'Read Data into an Array Variable
For column = LBound(Items) To UBound(Items)
'MsgBox Items(column)
ShippingPlanArray(column, row) = Items(column)
Next column
row = row + 1
Loop
Next file
End Sub
I don't know if fso support an overloaded method for GetFolder where you can specify the pattern. If it does, use that i.e. GetFolder(Path, "*.txt"). If it doesn't, can you not just add a simple condition to check the file extension in your 'for each' loop and only process the ones that ends in '.txt'.
Update:
Try this:
For Each file In folder2.Files
Dim extension As String
extension = LCase(Mid$(file, InStrRev(file, ".")))
If extension = ".txt" Then
Debug.Print "TEST"
End If
Next
I've tested it and it works as expected.
I'm converting a database from access to a sql backend access front end. The database has embedded pdf documents which end up getting stored as [image] data by SQL server's data import tools.
My problem is that I want the users to be able to open the pdf file by clicking the pdf icon in a report created in access.
Can this be done with VBA or is there an easier way? I'm at a total loss on how to make this happen.
Thanks for the answer!
I edited the BlobToFile function to strip out the ole header since adobe couldn't read the file (evince could and so could mac preview)
I was able to do what I wanted like this:
Private Sub PDFDocument_Click()
Call BlobToFile("C:\db\MyPDFFile.pdf", Me.PDFDocument)
If Dir("C:\db\MyPDFFile.pdf") <> "" Then
FollowHyperlink ("C:\db\MyPDFFile.pdf")
End If
End Sub
'Function: BlobToFile - Extracts the data in a binary field to a disk file.
'Parameter: strFile - Full path and filename of the destination file.
'Parameter: Field - The field containing the blob.
'Return: The length of the data extracted.
Public Function BlobToFile(strFile As String, ByRef Field As Object) As Long
On Error GoTo BlobToFileError
Dim nFileNum As Integer
Dim abytData() As Byte
Dim abytParsedData() As Byte
Dim copyOn As Boolean
Dim copyIndex As Long
BlobToFile = 0
nFileNum = FreeFile
copyOn = False
copyIndex = 0
Open strFile For Binary Access Write As nFileNum
abytData = Field
ReDim abytParsedData(UBound(abytData))
For i = LBound(abytData) To UBound(abytData) - 1
If copyOn = False Then
If Chr(abytData(i)) = "%" And Chr(abytData(i + 1)) = "P" And Chr(abytData(i + 2)) = "D" And Chr(abytData(i + 3)) = "F" Then
copyOn = True
End If
End If
If copyOn = True Then
abytParsedData(copyIndex) = abytData(i)
copyIndex = copyIndex + 1
End If
Next
Put #nFileNum, , abytParsedData
BlobToFile = LOF(nFileNum)
BlobToFileExit:
If nFileNum > 0 Then Close nFileNum
Exit Function
BlobToFileError:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, _
"Error writing file in BlobToFile"
BlobToFile = 0
Resume BlobToFileExit
End Function
If I understand what you are trying to do, you basically want Adobe Reader to open an in-memory pdf file "object". This isn't possible. You'll need to write the pdf file out to the system hard drive and then open it from there. You can somewhat achieve what you're asking by either using the computers Temp folder or else managing the files/folder yourself. For example, you could possibly cleanup your PDF file folder every time the application opens.
Here's some code to help you do what you're trying to do. This code does not handle anything to do with creating folders, generating file names, checking to see if the file already exists, etc. I'm assuming that you'll be able to handle that. My code in Command1_Click assumes that you're using SQL Server with ODBC linked tables.
I'm using FollowHyperlink here but I highly recommend that you use Allen Browne's GoHyperlink function instead to open files. You'll probably have security errors with FollowHyperlink.
Private Sub Command1_Click()
Dim r As DAO.Recordset, sSQL As String
sSQL = "SELECT ID, BlobField FROM MyTable"
Set r = CurrentDb.OpenRecordset(sSQL, dbOpenDynaset, dbSeeChanges)
If Not (r.EOF And r.BOF) Then
Call BlobToFile("C:\MyPDFFile.pdf", r("BlobField"))
If Dir("C:\MyPDFFile.pdf") <> "" Then
FollowHyperlink("C:\MyPDFFile.pdf")
End If
End If
r.Close
Set r = Nothing
End Sub
'Function: BlobToFile - Extracts the data in a binary field to a disk file.
'Parameter: strFile - Full path and filename of the destination file.
'Parameter: Field - The field containing the blob.
'Return: The length of the data extracted.
Public Function BlobToFile(strFile As String, ByRef Field As Object) As Long
On Error GoTo BlobToFileError
Dim nFileNum As Integer
Dim abytData() As Byte
BlobToFile = 0
nFileNum = FreeFile
Open strFile For Binary Access Write As nFileNum
abytData = Field
Put #nFileNum, , abytData
BlobToFile = LOF(nFileNum)
BlobToFileExit:
If nFileNum > 0 Then Close nFileNum
Exit Function
BlobToFileError:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, _
"Error writing file in BlobToFile"
BlobToFile = 0
Resume BlobToFileExit
End Function