I have the code to replace the string of the predetermined variable, but it seems my code is not efficient, because if more strings that want to be replace, the more replace functions, how do I handle this?
Dim appName As String
Dim appVer As String
Dim desc As String
appName = "MyProject"
appVer = App.Major & "." & App.Minor & "." & App.Revision
desc = "{appName} {appVer} is free program"
desc = Replace(desc, "{appName}", appName)
desc = Replace(desc, "{appVer}", appVer)
Label1.Caption = desc
Thanks for help
I answer my question
Public Function ReplaceString(sString As String) As String
Const Tag1 = "{"
Const Tag2 = "}"
Dim sItem() As String, i As Long
sString = Replace(sString, "\n", vbNewLine) 'Replace new line
sItem = Split(sString, Tag1)
For i = 1 To UBound(sItem)
sItem(i - 1) = Split(sItem(i), Tag2, 2)(0)
Next
ReDim Preserve sItem(UBound(sItem) - 1)
For i = 0 To UBound(sItem)
sString = Replace(sString, "{" & sItem(i) & "}", CallByName(Me, sItem(i), VbGet))
Next
ReplaceString = sString
End Function
Hope this will help other in same case
Related
I have a problem in that I need to read a specified quantity of characters from a text file, but the specified quantity varies so I cannot use a constant EG:
variable = WhateverIsSpecified
strText = objFile.Read (variable) ' 1 ~ n+1
objOutfile.write strText
NOT
strText = objFile.Read (n) ' n = any constant (interger)
When using the first way, the output is blank (no characters in the output file)
Thanks in advance
UPDATE
These are the main snippets in a bit longer code
Set file1 = fso.OpenTextFile(file)
Do Until file1.AtEndOfStream
line = file1.ReadLine
If (Instr(line,"/_N_") =1) then
line0 = replace(line, "/", "%")
filename = file1.Readline
filename = Left(filename, len(filename)-3) & "arc"
Set objOutFile = fso.CreateTextFile(destfolder & "\" & filename)
For i = 1 to 5
line = file1.Readline
next
nBytes = line 'this line contains the quantity needed to be read eg 1234
Do until Instr(line,"\") > 0
line = file1.ReadLine
Loop
StrData = ObjFile.Read (nBytes)
objOutFile.Write StrData
objOutFile.close
End if
Loop
WScript.quit
My own stupid error,
StrData = ObjFile.Read (nBytes)
should be
StrData = file1.Read (nBytes)
I currently have code written to take the fields of one workbook and copy into another workbook. I currently take a range and 'snapshot' it then save that as a separate .bmp file.
I also would like to take this snapshot and attach it into a cell of the workbook I'm copying everything over into. Anybody have any advice, or see here i can add code for this?
Sub Macro4()
'
' Record and File report
Dim Model As String
Dim IssueDate As String
Dim ConcernNo As String
Dim IssuedBy As String
Dim FollowedSEC As String
Dim FollowedBy As String
Dim RespSEC As String
Dim RespBy As String
Dim Timing As String
Dim Title As String
Dim PartNo As String
Dim Block As String
Dim Supplier As String
Dim Other As String
Dim Detail As String
Dim CounterTemp As String
Dim CounterPerm As String
Dim VehicleNo As String
Dim OperationNo As String
Dim Line As String
Dim Remarks As String
Dim ConcernMemosMaster As Workbook
Dim LogData As String
Dim newFile As String
Dim fName As String
Dim Filepath As String
Dim DTAddress As String
Dim pic_rng As Range
Dim ShTemp As Worksheet
Dim ChTemp As Chart
Dim PicTemp As Picture
'Determines if any required cells are empty and stops process if there are. displays error message.
If IsEmpty(Range("c2")) Or IsEmpty(Range("AT3")) Or IsEmpty(Range("BI2")) Or IsEmpty(Range("M7")) Or IsEmpty(Range("C10")) Or IsEmpty(Range("AP14")) Or IsEmpty(Range("C14")) Or IsEmpty(Range("C23")) Or IsEmpty(Range("C37")) Or IsEmpty(Range("J51")) Or IsEmpty(Range("AA51")) Or IsEmpty(Range("C55")) Or IsEmpty(Range("AR51")) Then
MsgBox "Please fill out all required fields and retry.", vbOKOnly
Exit Sub
End If
If Dir("N:\") = "" Then '"N" drive not found, abort sub
MsgBox "Error: Drive, path or file not found. Please email copy of file to: "
Exit Sub
End If
'assigns fields
Worksheets("ConcernMemo").Select
Model = Range("c2")
IssueDate = Range("AT3")
ConcernNo = Range("BC3")
IssuedBy = Range("BI2")
FollowedSEC = Range("BA9")
FollowedBy = Range("BD9")
RespSEC = Range("BG9")
RespBy = Range("BJ9")
Timing = Range("M7")
Title = Range("C10")
PartNo = Range("AP14")
Block = Range("AP16")
Supplier = Range("AP18")
Other = Range("AZ14")
Detail = Range("C14")
CounterTemp = Range("C23")
CounterPerm = Range("C37")
VehicleNo = Range("J51")
OperationNo = Range("AA51")
Remarks = Range("C55")
Line = Range("AR51")
LogData = Format(Now(), "mm_dd_yyyy_hh_mmAMPM")
fName = Range("BC3").Value
newFile = fName & "_" & Format(Now(), "mmddyyyy_hhmmAMPM")
Filepath = "N:\Newell K\Concern_Memo\Concern_Memo_File_Drop\Concern_Memo_Records\" & fName & "_" & Format(Now(), "mmddyyyy_hhmmAMPM")
DTAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
'asks user is they are ready to send to database
If MsgBox("Are you ready to send record to database?", vbYesNo) = vbNo Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set pic_rng = Worksheets("ConcernMemo").Range("AK22:BK49")
Set ShTemp = Worksheets.Add
'Takes snapshot of image/sketch and saves to sharedrive
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name
Set ChTemp = ActiveChart
pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
ChTemp.Paste
Set PicTemp = Selection
With ChTemp.Parent
.Width = PicTemp.Width + 8
.Height = PicTemp.Height + 8
End With
ChTemp.Export fileName:="N:\Newell K\Concern_Memo\Concern_Memo_File_Drop\Concern_Memo_Images\" & newFile & ".bmp", FilterName:="bmp"
ShTemp.Delete
'opens db file on sharedrive and copies fields over
Set ConcernMemosMaster = Workbooks.Open("N:\Newell K\Concern_Memo\concern_memos_DBMASTER.xlsx")
Worksheets("sheet1").Select
Worksheets("sheet1").Range("a1").Select
RowCount = Worksheets("sheet1").Range("a1").CurrentRegion.Rows.Count
With Worksheets("sheet1")
.Range("a1").Offset(RowCount, 0) = Model
.Range("b1").Offset(RowCount, 0) = IssueDate
.Range("c1").Offset(RowCount, 0) = ConcernNo
.Range("d1").Offset(RowCount, 0) = IssuedBy
.Range("e1").Offset(RowCount, 0) = FollowedSEC
.Range("f1").Offset(RowCount, 0) = FollowedBy
.Range("g1").Offset(RowCount, 0) = RespSEC
.Range("h1").Offset(RowCount, 0) = RespBy
.Range("i1").Offset(RowCount, 0) = Timing
.Range("j1").Offset(RowCount, 0) = Title
.Range("k1").Offset(RowCount, 0) = PartNo
.Range("l1").Offset(RowCount, 0) = Block
.Range("m1").Offset(RowCount, 0) = Supplier
.Range("n1").Offset(RowCount, 0) = Other
.Range("o1").Offset(RowCount, 0) = Detail
.Range("p1").Offset(RowCount, 0) = CounterTemp
.Range("q1").Offset(RowCount, 0) = CounterPerm
.Range("r1").Offset(RowCount, 0) = VehicleNo
.Range("s1").Offset(RowCount, 0) = OperationNo
.Range("t1").Offset(RowCount, 0) = Remarks
.Range("U1").Offset(RowCount, 0) = PicTemp
.Range("V1").Offset(RowCount, 0) = LogData
.Range("w1").Offset(RowCount, 0) = Filepath
.Range("x1").Offset(RowCount, 0) = Line
'saves a copy to of entire file to sharedrive
ThisWorkbook.SaveCopyAs fileName:="N:\Newell K\Concern_Memo\Concern_Memo_File_Drop\Concern_Memo_Records\" & newFile & ".xlsm"
'Saves copy to desktop
Application.DisplayAlerts = True
ThisWorkbook.SaveCopyAs DTAddress & newFile & ".xlsm"
MsgBox "A copy has been saved to your desktop"
ThisWorkbook.SendMail Recipients:="kaitlin.newell#nissan-usa.com", _
Subject:="New Concern Memo"
End With
ConcernMemosMaster.Save
ConcernMemosMaster.Close
Application.DisplayAlerts = True
MsgBox "Please close out file without saving"
End Sub
Try this out :
Range("A1:D4").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
Range("A6").PasteSpecial
It will paste a copy of the "snapshot" of Range("A1:D4") at the cell A6.
EDIT : Since you have already set an object of that "target" workbook, you can use it to easily paste into it. Try this :
ConcernMemosMaster.Worksheets("sheet1").Range("A1:X1").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
ConcernMemosMaster.Worksheets("sheet1").Range("B1").PasteSpecial
This code is for updating the database, but every time I click the “start update” button, a “PATH NOT FOUND” error is shown.
Dim strEmpFileName As String
Dim strBackSlash As String
Dim intEmpFileNbr As Integer
Dim strEmpFileName1 As String
Dim strBackSlash1 As String
Dim intEmpFileNbr1 As Integer
Dim fPath As New FileSystemObject
Dim strEmpFileName2 As String
Dim strBackSlash2 As String
Dim intEmpFileNbr2 As Integer
Dim strEmpFileName21 As String
Dim strBackSlash21 As String
Dim intEmpFileNbr21 As Integer
Dim strEmpFileName21X As String
Dim strBackSlash21X As String
Dim intEmpFileNbr21X As Integer
Dim strEmpFileName21s As String
Dim strBackSlash21s As String
Dim intEmpFileNbr21s As Integer
strBackSlash = IIf(Right$(App.Path, 1) = "\", "", "\")
strEmpFileName = App.Path & strBackSlash & "\SOURCE\SWA.exe"
txtSource.Text = strEmpFileName
FileCopy txtSource.Text, "\\Mainfile\SSMS_UPDATE\SHIPS ACCOUNTING\SWA.exe"
FileCopy txtSource.Text, "C:\SANKO PROGRAM\SPECIAL WORK\SWA.exe"
Since you are already checking for a backslash in
strBackSlash = IIf(Right$(App.Path, 1) = "\", "", "\")
strEmpFileName = App.Path & strBackSlash & "\SOURCE\SWA.exe"
You should not need the backslash at the start of "\SOURCE\SWA.exe"
You are misusing the IIf function. Syntax, IIf(expr, truepart, falsepart). Your statement checks for a backslash and if the last character is "\", sets your variable to an empty string. But the false part sets the variable to "\" if it is not the last character in your path. For example, if App.Path = C:\MyApplication your IIF function would set strBackSlash = "\" and strEmpFileName will be C:\MyApplication\\SOURCE\SWA.exe.For your code you want to use a regular If statement to replace the backslash character with an empty string, then use the hard-coded backslash when you build the path.
strAppPath = App.Path
If(Right$(strAppPath, 1) = "\" Then
strAppPath = Left$(strAppPath, Len(strAppPath) - 1)
End Id
strEmpFileName = strAppPath & "\SOURCE\SWA.exe"
The full MSDN documentation is here.
Also, getting the application path is something that is done a lot. I suggest you write your own function to do this and add it to a project .bas file. Then you call the function from where ever you need it and the returned path format, (with or without the trailing backslash) is consistent. My personal function makes sure I have a trailing backslash.
Public Function AppPath() As String
Dim sAppPath As String
sAppPath = App.Path
If Right$(sAppPath, 1) <> "\" Then 'check that I'm not in the root
sAppPath = sAppPath & "\"
End If
AppPath = sAppPath
End Function
useage: strEmpFileName = AppPath() & "SOURCE\SWA.exe"
Often when describing an issue in code, I need to reference it by line/column/function.
Is there a macro/add-in for Visual Studio that copies that information for me?
It would be perfect if it could copy to clipboard: File, Line, column, function name
But I'd take any combination :).
Thanks!
I ended up doing a macro. Unfortunately I was unable to access the clipboard from the macro so I had to use NirCmd for that part. Other than that, it works great!
Public Sub CopyLocation()
Dim fileName = DTE.ActiveDocument.Name
Dim line = ""
Dim column = ""
Dim functionName = ""
Dim className = ""
Dim textDocument = TryCast(DTE.ActiveDocument.Object, TextDocument)
If textDocument IsNot Nothing Then
Dim activePoint = textDocument.Selection.ActivePoint
column = activePoint.DisplayColumn
line = activePoint.Line
Dim codeElement As CodeElement
codeElement = activePoint.CodeElement(vsCMElement.vsCMElementFunction)
If codeElement IsNot Nothing Then
functionName = codeElement.Name
End If
codeElement = activePoint.CodeElement(vsCMElement.vsCMElementClass)
If codeElement IsNot Nothing Then
className = codeElement.Name
End If
End If
Dim output As String = String.Format("File: {0} ", fileName)
If (String.IsNullOrEmpty(line) = False) Then output = output & String.Format("Line: {0} ", line)
If (String.IsNullOrEmpty(column) = False) Then output = output & String.Format("Column: {0} ", column)
If (String.IsNullOrEmpty(className) = False) Then output = output & String.Format("at {0}", className)
If (String.IsNullOrEmpty(functionName) = False) Then output = output & String.Format(".{0}", functionName)
Dim process As System.Diagnostics.Process
process.Start("c:\NoInstall files\nircmd.exe", String.Format("clipboard set ""{0}""", output))
End Sub
Please find below the code..
Function Connect_to_db(Byval mfgprt)
Dim cnn,rss
Set cnn = CreateObject("ADODB.Connection")
Set rss = CreateObject("ADODB.recordset")
cnn.ConnectionString = "DSN=QTPDSN;Description=desc;UID=;PWD=;APP=QuickTest Professional;WSID=;DATABASE=;"
cnn.open
rss = cnn.Execute (""select UnitPrice from ProductProfilePrices where MfPartNumber ='" + mfgprt + "'")
Connect_to_db=rss(0)
End Function
In this function, if I change a col name unit price in Query with '*' then it will return more than one value..in that case how to use rss .....
As if i'll do it(replace unit price with '*'),then while running it populates an error..in rss data fetching..
please by doing same modify the code.....
Thanks,
Galstar
You can refer to the fields by name, but first rss should be an object, so use Set, also the string concatenator is & :
Set rss = cnn.Execute (""select UnitPrice, Quantity " _
& " from ProductProfilePrices where MfPartNumber ='" & mfgprt & "'")
''Let us say that only one row is returned for mfgprt :
varUnitPrice = rss("UnitPrice")
varQuantity = rss("Quantity")
EDIT re comments
Connect_to_db "AAA", Val1, Val2
MsgBox Val1 & " " & Val2
Function Connect_to_db(ByVal mfgprt, ByRef Val1, ByRef Val2)
Dim cnn, rss
Set cnn = CreateObject("ADODB.Connection")
Set rss = CreateObject("ADODB.recordset")
cnn.ConnectionString = "DSN=QTPDSN;Description=desc;" _
& "UID=;PWD=;APP=QuickTest Professional;WSID=;DATABASE=;"
cnn.Open
rss = cnn.Execute("select UnitPrice, Quantity " _
& " from ProductProfilePrices where MfPartNumber ='" & mfgprt & "'")
Val1 = rss(0)
Val2 = rss(1)
End Function